bitcoind-regtest 0.1.0.0 → 0.2.0.0
raw patch · 6 files changed
+320/−204 lines, 6 filesdep +bytestringdep +optparse-applicativedep ~basedep ~bitcoind-rpcdep ~haskoin-corenew-component:exe:bitcoind-rpc-explorerPVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring, optparse-applicative
Dependency ranges changed: base, bitcoind-rpc, haskoin-core, http-client, servant, servant-client, tasty
API changes (from Hackage documentation)
+ Bitcoin.Core.Regtest: [nodeRawBlock] :: NodeHandle -> FilePath
+ Bitcoin.Core.Regtest: [nodeRawTx] :: NodeHandle -> FilePath
- Bitcoin.Core.Regtest: NodeHandle :: Int -> BasicAuthData -> NodeHandle
+ Bitcoin.Core.Regtest: NodeHandle :: Int -> BasicAuthData -> FilePath -> FilePath -> NodeHandle
Files
- CHANGELOG.md +4/−0
- LICENSE +28/−0
- bitcoind-regtest.cabal +21/−10
- rpc-explorer/Main.hs +62/−0
- src/Bitcoin/Core/Regtest.hs +148/−124
- test/Main.hs +57/−70
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for bitcoind-regtest +## 0.2.0.0 -- 2020-11-01 ++* Create zmq sockets for block and transaction subscriptions to the ephemeral node+ ## 0.1.0.0 -- 2020-03-07 Initial release
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright 2020 Bitnomial, Inc.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder nor the names of its+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+HOLDER 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.
bitcoind-regtest.cabal view
@@ -1,9 +1,11 @@ cabal-version: 2.4 name: bitcoind-regtest-version: 0.1.0.0+version: 0.2.0.0 synopsis: A library for working with bitcoin-core regtest networks-homepage: https://github.com/GambolingPangolin/bitcoind-rpc-license: ISC+homepage: https://github.com/bitnomial/bitcoind-rpc+license: BSD-3-Clause+license-file: LICENSE+copyright: Bitnomial, Inc. (c) 2020 author: Ian Shipman maintainer: ics@gambolingpangolin.com build-type: Simple@@ -13,14 +15,14 @@ default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind build-depends:- base ^>=4.12- , bitcoind-rpc+ base >=4.12 && <4.15+ , bitcoind-rpc ^>=0.2 , cereal ^>=0.5- , haskoin-core >=0.9 && <0.12- , http-client ^>=0.6+ , haskoin-core >=0.15 && <0.18+ , http-client >=0.6 && <0.8 , process ^>=1.6- , servant >=0.15 && <0.18- , servant-client >=0.15 && <0.18+ , servant >=0.15 && <0.19+ , servant-client >=0.15 && <0.19 , temporary ^>=1.3 , text ^>=1.2 @@ -34,7 +36,16 @@ build-depends: containers >=0.5 && <0.7 +executable bitcoind-rpc-explorer+ import: core+ main-is: Main.hs+ hs-source-dirs: rpc-explorer/+ build-depends:+ bitcoind-regtest+ , bytestring >=0.10 && <0.12+ , optparse-applicative >=0.14 && <0.17 + test-suite bitcoind-rpc-tests import: core type: exitcode-stdio-1.0@@ -42,5 +53,5 @@ hs-source-dirs: test/ build-depends: bitcoind-regtest- , tasty ^>=1.2+ , tasty >=1.2 && <1.5 , tasty-hunit ^>=0.10
+ rpc-explorer/Main.hs view
@@ -0,0 +1,62 @@+module Main where++import Control.Applicative (optional, (<**>))+import Control.Monad ((>=>))+import Data.ByteString.Char8 (unpack)+import Data.List (isPrefixOf, sort)+import Data.Maybe (listToMaybe, mapMaybe)+import Options.Applicative (+ ParserInfo,+ execParser,+ help,+ helper,+ info,+ long,+ progDesc,+ short,+ strOption,+ )+import Servant.API (BasicAuthData (..))+import System.Process (readProcess)++import Bitcoin.Core.Regtest (+ NodeHandle,+ nodeAuth,+ nodePort,+ withBitcoind,+ )++opts :: ParserInfo (Maybe FilePath)+opts = info (outputOpt <**> helper) $ progDesc "Create a representation of the bitcoind rpc command set"+ where+ outputOpt =+ optional . strOption $+ short 'o' <> long "output" <> help "Omitting this argument outputs to stdout"++main :: IO ()+main = do+ outputFile <- execParser opts+ mapM_ (`writeFile` mempty) outputFile+ let writeOutput = maybe putStrLn appendFile outputFile+ withBitcoind 8330 $ \h -> do+ rpcCommands <- parseHelpText <$> bitcoinCli h ["help"]+ writeOutput $ unlines rpcCommands+ mapM_ (getHelpText h >=> writeOutput) rpcCommands+ where+ getHelpText h c = bitcoinCli h ["help", c]++-- | Compute the sorted list of available RPC commands+parseHelpText :: String -> [String]+parseHelpText = sort . mapMaybe (listToMaybe . words) . filter isRpc . lines+ where+ isRpc = not . isPrefixOf "="++bitcoinCli :: NodeHandle -> [String] -> IO String+bitcoinCli h args =+ readProcess "bitcoin-cli" (setupArgs <> args) mempty+ where+ setupArgs =+ [ "-rpcport=" <> show (nodePort h)+ , "-rpcuser=" <> (unpack . basicAuthUsername . nodeAuth) h+ , "-rpcpassword=" <> (unpack . basicAuthPassword . nodeAuth) h+ ]
src/Bitcoin/Core/Regtest.hs view
@@ -1,120 +1,153 @@ {-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} -module Bitcoin.Core.Regtest- (+module Bitcoin.Core.Regtest ( -- * Run an ephemeral regtest node- NodeHandle (..)- , runBitcoind- , withBitcoind+ NodeHandle (..),+ runBitcoind,+ withBitcoind, -- * Funding- , oneBitcoin- , createOutput- , generate- , spendPackageOutputs+ oneBitcoin,+ createOutput,+ generate,+ spendPackageOutputs, -- * Internal wallet+ --- -- | In the following lists, entries correspond to each other e.g. the p2pkh+ -- In the following lists, entries correspond to each other e.g. the p2pkh -- address for @keys !! 1@ is @addrs !! 1@.- , xprv- , keys- , pubKeys- , addrs- , textAddrs- ) where--import Control.Concurrent (threadDelay)-import Control.Exception (bracket)-import Control.Monad (void)-import qualified Data.Serialize as S-import Data.Text (Text)-import Data.Word (Word64)-import Network.Haskoin.Address (Address, addrToString,- addressToOutput)-import Network.Haskoin.Block (blockTxns)-import Network.Haskoin.Constants (btcTest)-import Network.Haskoin.Crypto (SecKey)-import Network.Haskoin.Keys (PubKeyI, XPrvKey (..),- deriveAddrs, derivePubKeyI,- deriveXPubKey, makeXPrvKey,- prvSubKeys, wrapSecKey)-import Network.Haskoin.Script (sigHashAll)-import Network.Haskoin.Transaction (OutPoint (..), SigInput (..),- Tx (..), TxOut (..), buildAddrTx,- signTx, txHash)-import Network.Haskoin.Util (encodeHex, maybeToEither)-import Network.HTTP.Client (Manager)-import Servant.API (BasicAuthData)-import System.IO (Handle, IOMode (..), openFile)-import System.IO.Temp (withSystemTempDirectory)-import System.Process (CreateProcess (..), ProcessHandle,- StdStream (..), createProcess,- proc, terminateProcess,- waitForProcess)+ xprv,+ keys,+ pubKeys,+ addrs,+ textAddrs,+) where -import Bitcoin.Core.RPC (BitcoindClient, BitcoindException,- basicAuthFromCookie)-import qualified Bitcoin.Core.RPC as RPC+import Control.Concurrent (threadDelay)+import Control.Exception (bracket)+import Control.Monad (void)+import qualified Data.Serialize as S+import Data.Text (Text)+import Data.Word (Word64)+import Haskoin.Address (+ Address,+ addrToText,+ addressToOutput,+ )+import Haskoin.Block (blockTxns)+import Haskoin.Constants (btcTest)+import Haskoin.Crypto (SecKey)+import Haskoin.Keys (+ PubKeyI,+ XPrvKey (..),+ deriveAddrs,+ derivePubKeyI,+ deriveXPubKey,+ makeXPrvKey,+ prvSubKeys,+ wrapSecKey,+ )+import Haskoin.Script (sigHashAll)+import Haskoin.Transaction (+ OutPoint (..),+ SigInput (..),+ Tx (..),+ TxOut (..),+ buildAddrTx,+ signTx,+ txHash,+ )+import Haskoin.Util (encodeHex, maybeToEither)+import Network.HTTP.Client (Manager)+import Servant.API (BasicAuthData)+import System.IO (Handle, IOMode (..), openFile)+import System.IO.Temp (getCanonicalTemporaryDirectory, withSystemTempDirectory)+import System.Process (+ CreateProcess (..),+ ProcessHandle,+ StdStream (..),+ createProcess,+ proc,+ terminateProcess,+ waitForProcess,+ ) +import Bitcoin.Core.RPC (+ BitcoindClient,+ BitcoindException,+ basicAuthFromCookie,+ )+import qualified Bitcoin.Core.RPC as RPC -- | Data needed to connect to a @bitcoind-regtest@ ephemeral node data NodeHandle = NodeHandle { nodePort :: Int , nodeAuth :: BasicAuthData+ , nodeRawTx :: FilePath+ , nodeRawBlock :: FilePath } - -- | Run an RPC computation with an ephemeral node runBitcoind :: Manager -> NodeHandle -> BitcoindClient r -> IO (Either BitcoindException r)-runBitcoind mgr (NodeHandle port auth) = RPC.runBitcoind mgr "127.0.0.1" port auth-+runBitcoind mgr (NodeHandle port auth _ _) = RPC.runBitcoind mgr "127.0.0.1" port auth -- | Provide bracketed access to a fresh ephemeral node-withBitcoind- :: Int- -- ^ node port- -> (NodeHandle -> IO r)- -> IO r-withBitcoind port k = withSystemTempDirectory "bitcoind-rpc-tests" $ \dd ->- bracket (initBitcoind dd port) stopBitcoind . const $ do+withBitcoind ::+ -- | node port+ Int ->+ (NodeHandle -> IO r) ->+ IO r+withBitcoind port k = withSystemTempDirectory "bitcoind-rpc-tests" $ \dd -> do+ tmp <- getCanonicalTemporaryDirectory+ bracket (initBitcoind tmp dd port) stopBitcoind . const $ do auth <- basicAuthFromCookie $ dd <> "/regtest/.cookie"- k $ NodeHandle port auth-+ k $ NodeHandle port auth (rawTxSocket tmp) (rawBlockSocket tmp) -initBitcoind :: FilePath -> Int -> IO ProcessHandle-initBitcoind ddir port = do- logH <- openFile "/tmp/bitcoind-rpc.log" WriteMode- (_, _, _, h) <- createProcess $ bitcoind ddir port logH+initBitcoind :: FilePath -> FilePath -> Int -> IO ProcessHandle+initBitcoind tmp ddir port = do+ logH <- openFile (tmp <> "/bitcoind-rpc.log") WriteMode+ (_, _, _, h) <- createProcess $ bitcoind tmp ddir port logH h <$ threadDelay 1_000_000 - stopBitcoind :: ProcessHandle -> IO () stopBitcoind h = terminateProcess h >> void (waitForProcess h) +bitcoind :: FilePath -> FilePath -> Int -> Handle -> CreateProcess+bitcoind tmp ddir port output =+ (proc "bitcoind" args)+ { std_out = UseHandle output+ , std_err = UseHandle output+ }+ where+ args =+ [ "-regtest"+ , "-txindex"+ , "-blockfilterindex=1"+ , "-disablewallet"+ , "-datadir=" <> ddir+ , "-rpcport=" <> show port+ , "-zmqpubrawblock=" <> rawBlockSocket tmp+ , "-zmqpubrawtx=" <> rawTxSocket tmp+ ] -bitcoind :: FilePath -> Int -> Handle -> CreateProcess-bitcoind ddir port output- = (proc "bitcoind" args)- { std_out = UseHandle output- , std_err = UseHandle output- }- where- args = ["-regtest", "-txindex", "-disablewallet", "-datadir=" <> ddir, "-rpcport=" <> show port]+rawTxSocket :: FilePath -> String+rawTxSocket tmp = "ipc://" <> tmp <> "/bitcoind-rpc.tx.raw" +rawBlockSocket :: FilePath -> String+rawBlockSocket tmp = "ipc://" <> tmp <> "/bitcoind-rpc.block.raw" oneBitcoin :: Word64 oneBitcoin = 100_000_000 - -- | Funds an output with the minimum of the given amount and 100 blocks of subsidies-createOutput- :: Address- -- ^ address for the newly created output- -> Word64- -- ^ target amount- -> BitcoindClient (OutPoint, Word64)+createOutput ::+ -- | address for the newly created output+ Address ->+ -- | target amount+ Word64 ->+ BitcoindClient (OutPoint, Word64) createOutput addr vTarget = do inputs <- generateEnoughBlocks vTarget -- Make mined outputs spendable@@ -126,10 +159,9 @@ return (OutPoint h 0, vFund) - generateEnoughBlocks :: Word64 -> BitcoindClient [(OutPoint, Word64)] generateEnoughBlocks vTarget = go ([], 0, 0 :: Int)- where+ where go (xs, v, n) | n >= 100 = return xs | otherwise = do@@ -137,83 +169,75 @@ let xs' = x : xs if v + v0 >= vTarget then return xs'- else go (xs', v + v0, n+1)-+ else go (xs', v + v0, n + 1) --- | A simplified block generator which does not require the tester to manage a--- wallet. Use 'spendPackageOutputs' to spend.+{- | A simplified block generator which does not require the tester to manage a+ wallet. Use 'spendPackageOutputs' to spend.+-} generate :: BitcoindClient (OutPoint, Word64)-generate- = fmap (processCoinbase . head . blockTxns)- $ RPC.generateToAddress 1 textAddr0 Nothing >>= RPC.getBlock . head- where- processCoinbase tx0 = (OutPoint (txHash tx0) 0 , outValue . head $ txOut tx0)-+generate =+ fmap (processCoinbase . head . blockTxns) $+ RPC.generateToAddress 1 textAddr0 Nothing >>= RPC.getBlock . head+ where+ processCoinbase tx0 = (OutPoint (txHash tx0) 0, outValue . head $ txOut tx0) -- | Spend outputs created by 'generate'-spendPackageOutputs- :: [(OutPoint, Word64)]- -- ^ outputs produced by 'generate'- -> Address- -- ^ recipient address- -> Word64- -- ^ amount to spend- -> Either String (Tx, Word64)+spendPackageOutputs ::+ -- | outputs produced by 'generate'+ [(OutPoint, Word64)] ->+ -- | recipient address+ Address ->+ -- | amount to spend+ Word64 ->+ Either String (Tx, Word64) spendPackageOutputs inputs addr vTarget = do- addrText <- maybeToEither "Addr conversion failed" $ addrToString btcTest addr-- let outSpec | vTarget + 10_000 < vAvail- = Right ([(addrText, vTarget), (textAddr1, vAvail - vTarget - 10_000)], vTarget)-- | vAvail > 10_000- = Right ([(addrText, vAvail - 10_000)], vAvail - 10_000)+ addrText <- maybeToEither "Addr conversion failed" $ addrToText btcTest addr - | otherwise- = Left "Insufficient funds"+ let outSpec+ | vTarget + 10_000 < vAvail =+ Right ([(addrText, vTarget), (textAddr1, vAvail - vTarget - 10_000)], vTarget)+ | vAvail > 10_000 =+ Right ([(addrText, vAvail - 10_000)], vAvail - 10_000)+ | otherwise =+ Left "Insufficient funds" - vAvail = sum $ snd <$> inputs+ vAvail = sum $ snd <$> inputs sigIn (op, val) = SigInput (addressToOutput addr0) val op sigHashAll Nothing (outs, vFund) <- outSpec- txSpec <- buildAddrTx btcTest (fst <$> inputs) outs- tx <- signTx btcTest txSpec (sigIn <$> inputs) [key0]+ txSpec <- buildAddrTx btcTest (fst <$> inputs) outs+ tx <- signTx btcTest txSpec (sigIn <$> inputs) [key0] return (tx, vFund) - -- | Root key for the package wallet xprv :: XPrvKey xprv = makeXPrvKey "bitcoind-regtest key seed" - -- | Example secret keys keys :: [SecKey] keys = xPrvKey . fst <$> prvSubKeys xprv 0 - -- | Example public keys pubKeys :: [PubKeyI] pubKeys = derivePubKeyI . wrapSecKey True <$> keys - key0 :: SecKey key0 : _ = keys - -- | Example p2pkh addresses addrs :: [Address] addrs = repack <$> deriveAddrs (deriveXPubKey xprv) 0- where repack (x, _, _) = x-+ where+ repack (x, _, _) = x addr0 :: Address addr0 : _ = addrs - -- | Text versions of the example addresses textAddrs :: [Text]-textAddrs = addrToString' <$> addrs- where addrToString' a = let Just x = addrToString btcTest a in x-+textAddrs = addrToText' <$> addrs+ where+ addrToText' a = let Just x = addrToText btcTest a in x textAddr0, textAddr1, textAddr2 :: Text textAddr0 : textAddr1 : textAddr2 : _ = textAddrs
test/Main.hs view
@@ -1,100 +1,93 @@ {-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Monad (replicateM, void, (>=>))-import Data.Text (Text)-import Data.Word (Word64)-import Network.Haskoin.Address (Address (..), addrToString,- pubKeyAddr)-import Network.Haskoin.Block (Block (..), BlockHash,- BlockHeader)-import Network.Haskoin.Constants (btcTest)-import Network.Haskoin.Crypto (Hash160, SecKey)-import Network.Haskoin.Keys (PubKeyI, derivePubKeyI, secKey,- wrapSecKey)-import Network.Haskoin.Transaction (OutPoint (..), Tx (..), TxHash,- txHash)-import Network.HTTP.Client (defaultManagerSettings,- newManager)-import Test.Tasty (defaultMain)-import Test.Tasty.HUnit (assertFailure, testCase)--import Bitcoin.Core.Regtest (NodeHandle, withBitcoind)-import qualified Bitcoin.Core.Regtest as R-import Bitcoin.Core.RPC+import Control.Monad (replicateM, void, (>=>))+import Data.Text (Text)+import Data.Word (Word64)+import Haskoin.Address (Address (..), addrToText, pubKeyAddr)+import Haskoin.Block (Block (..), BlockHash)+import Haskoin.Constants (btcTest)+import Haskoin.Crypto (Hash160, SecKey)+import Haskoin.Keys (+ PubKeyI,+ derivePubKeyI,+ secKey,+ wrapSecKey,+ )+import Haskoin.Transaction (OutPoint (..), Tx (..), TxHash, txHash)+import Network.HTTP.Client (defaultManagerSettings, newManager)+import Test.Tasty (defaultMain)+import Test.Tasty.HUnit (assertFailure, testCase) +import Bitcoin.Core.RPC+import Bitcoin.Core.Regtest (NodeHandle, withBitcoind)+import qualified Bitcoin.Core.Regtest as R main :: IO ()-main- = defaultMain . testCase "bitcoind-rpc" . withBitcoind 8449- $ bitcoindTests- [ testRpc "generatetoaddress" testGenerate- , testRpc "getbestblockhash" getBestBlockHash- , testRpc "getblockhash" $ getBlockHash 1- , testRpc "getblockheader" testBlockHeader- , testRpc "getblock" testBlock- , testRpc "getblockcount" getBlockCount- , testRpc "getdifficulty" getDifficulty- , testRpc "getchaintips" getChainTips- , testRpc "getchaintxstats" $ getChainTxStats Nothing Nothing- , testRpc "getmempoolinfo" getMempoolInfo- , testRpc "getrawmempool" getRawMempool- , testRpc "getrawtransaction" testGetTransaction- , testRpc "sendrawtransaction" testSendTransaction- , testRpc "createOutput" testCreateOutput- , testRpc "getmempoolancestors" testMempoolAncestors- , testRpc "getmempooldescendants" testMempoolDescendants- , testRpc "getpeerinfo" getPeerInfo- , testRpc "getconnectioncount" getConnectionCount- , testRpc "getnodeaddresses" $ getNodeAddresses (Just 10)- , testRpc "getaddednodeinfo" $ getAddedNodeInfo Nothing- , testRpc "listbanned" listBanned- , testRpc "getnettotals" getNetTotals- , testRpc "uptime" uptime- , testRpc "addnode" $ addNode "127.0.0.1:8448" Add- , testRpc "clearbanned" clearBanned- ]-+main =+ defaultMain . testCase "bitcoind-rpc" . withBitcoind 8449 $+ bitcoindTests+ [ testRpc "generatetoaddress" testGenerate+ , testRpc "getbestblockhash" getBestBlockHash+ , testRpc "getblockhash" $ getBlockHash 1+ , testRpc "getblockfilter" $ testBlockFilter+ , testRpc "getblockheader" testBlockHeader+ , testRpc "getblock" testBlock+ , testRpc "getblockcount" getBlockCount+ , testRpc "getdifficulty" getDifficulty+ , testRpc "getchaintips" getChainTips+ , testRpc "getchaintxstats" $ getChainTxStats Nothing Nothing+ , testRpc "getmempoolinfo" getMempoolInfo+ , testRpc "getrawmempool" getRawMempool+ , testRpc "getrawtransaction" testGetTransaction+ , testRpc "sendrawtransaction" testSendTransaction+ , testRpc "createOutput" testCreateOutput+ , testRpc "getmempoolancestors" testMempoolAncestors+ , testRpc "getmempooldescendants" testMempoolDescendants+ , testRpc "getpeerinfo" getPeerInfo+ , testRpc "getconnectioncount" getConnectionCount+ , testRpc "getnodeaddresses" $ getNodeAddresses (Just 10)+ , testRpc "getaddednodeinfo" $ getAddedNodeInfo Nothing+ , testRpc "listbanned" listBanned+ , testRpc "getnettotals" getNetTotals+ , testRpc "uptime" uptime+ , testRpc "addnode" $ addNode "127.0.0.1:8448" Add+ , testRpc "clearbanned" clearBanned+ ] testGenerate :: BitcoindClient [BlockHash] testGenerate = generateToAddress 120 addrText Nothing - key :: SecKey Just key = secKey "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" - pk :: PubKeyI pk = derivePubKeyI $ wrapSecKey True key - addr :: Address addrHash :: Hash160 addr@(PubKeyAddress addrHash) = pubKeyAddr pk - addrText :: Text-Just addrText = addrToString btcTest addr-+Just addrText = addrToText btcTest addr testBlock :: BitcoindClient Block testBlock = getBestBlockHash >>= getBlock +testBlockFilter :: BitcoindClient CompactFilter+testBlockFilter = getBestBlockHash >>= getBlockFilter testBlockHeader :: BitcoindClient BlockHeader testBlockHeader = getBestBlockHash >>= getBlockHeader - testBlockStats :: BitcoindClient BlockStats testBlockStats = getBestBlockHash >>= getBlockStats - testGetTransaction :: BitcoindClient Tx-testGetTransaction- = getBestBlockHash >>= getBlock >>= (`getTransaction` Nothing) . txHash . head . blockTxns-+testGetTransaction =+ getBestBlockHash >>= getBlock >>= (`getTransaction` Nothing) . txHash . head . blockTxns testSendTransaction :: BitcoindClient TxHash testSendTransaction = do@@ -102,31 +95,25 @@ let Right (tx, _) = R.spendPackageOutputs [outp] (R.addrs !! 3) R.oneBitcoin sendTransaction tx Nothing - testMempoolAncestors :: BitcoindClient [TxHash] testMempoolAncestors = testSendTransaction >>= getMempoolAncestors - testMempoolDescendants :: BitcoindClient [TxHash] testMempoolDescendants = testSendTransaction >>= getMempoolAncestors - testCreateOutput :: BitcoindClient (OutPoint, Word64) testCreateOutput = R.createOutput (R.addrs !! 4) (2 * R.oneBitcoin) - testRpc :: String -> BitcoindClient r -> (String, BitcoindClient ()) testRpc name x = (name, void x) - bitcoindTests :: [(String, BitcoindClient ())] -> NodeHandle -> IO () bitcoindTests ts h = do mgr <- newManager defaultManagerSettings let run msg = R.runBitcoind mgr h >=> assertRight msg mapM_ (uncurry run) ts - assertRight :: Show a => String -> Either a b -> IO b assertRight msg = either onFail return- where+ where onFail e = assertFailure $ msg <> " - " <> show e