diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/bitcoind-regtest.cabal b/bitcoind-regtest.cabal --- a/bitcoind-regtest.cabal +++ b/bitcoind-regtest.cabal @@ -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 diff --git a/rpc-explorer/Main.hs b/rpc-explorer/Main.hs new file mode 100644 --- /dev/null +++ b/rpc-explorer/Main.hs @@ -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 + ] diff --git a/src/Bitcoin/Core/Regtest.hs b/src/Bitcoin/Core/Regtest.hs --- a/src/Bitcoin/Core/Regtest.hs +++ b/src/Bitcoin/Core/Regtest.hs @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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