bitcoind-regtest (empty) → 0.1.0.0
raw patch · 5 files changed
+404/−0 lines, 5 filesdep +basedep +bitcoind-regtestdep +bitcoind-rpcsetup-changed
Dependencies added: base, bitcoind-regtest, bitcoind-rpc, cereal, containers, haskoin-core, http-client, process, servant, servant-client, tasty, tasty-hunit, temporary, text
Files
- CHANGELOG.md +5/−0
- Setup.hs +2/−0
- bitcoind-regtest.cabal +46/−0
- src/Bitcoin/Core/Regtest.hs +219/−0
- test/Main.hs +132/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for bitcoind-regtest++## 0.1.0.0 -- 2020-03-07++Initial release
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bitcoind-regtest.cabal view
@@ -0,0 +1,46 @@+cabal-version: 2.4+name: bitcoind-regtest+version: 0.1.0.0+synopsis: A library for working with bitcoin-core regtest networks+homepage: https://github.com/GambolingPangolin/bitcoind-rpc+license: ISC+author: Ian Shipman+maintainer: ics@gambolingpangolin.com+build-type: Simple+extra-source-files: CHANGELOG.md++common core+ default-language: Haskell2010+ ghc-options: -Wall -fno-warn-unused-do-bind+ build-depends:+ base ^>=4.12+ , bitcoind-rpc+ , cereal ^>=0.5+ , haskoin-core >=0.9 && <0.12+ , http-client ^>=0.6+ , process ^>=1.6+ , servant >=0.15 && <0.18+ , servant-client >=0.15 && <0.18+ , temporary ^>=1.3+ , text ^>=1.2++library+ import: core+ hs-source-dirs: src/++ exposed-modules:+ Bitcoin.Core.Regtest++ build-depends:+ containers >=0.5 && <0.7+++test-suite bitcoind-rpc-tests+ import: core+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test/+ build-depends:+ bitcoind-regtest+ , tasty ^>=1.2+ , tasty-hunit ^>=0.10
+ src/Bitcoin/Core/Regtest.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}++module Bitcoin.Core.Regtest+ (+ -- * Run an ephemeral regtest node+ NodeHandle (..)+ , runBitcoind+ , withBitcoind++ -- * Funding+ , oneBitcoin+ , createOutput+ , generate+ , spendPackageOutputs++ -- * Internal wallet+ --+ -- | 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)++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+ }+++-- | 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+++-- | 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+ auth <- basicAuthFromCookie $ dd <> "/regtest/.cookie"+ k $ NodeHandle port auth+++initBitcoind :: FilePath -> Int -> IO ProcessHandle+initBitcoind ddir port = do+ logH <- openFile "/tmp/bitcoind-rpc.log" WriteMode+ (_, _, _, h) <- createProcess $ bitcoind ddir port logH+ h <$ threadDelay 1_000_000+++stopBitcoind :: ProcessHandle -> IO ()+stopBitcoind h = terminateProcess h >> void (waitForProcess h)+++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]+++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 addr vTarget = do+ inputs <- generateEnoughBlocks vTarget+ -- Make mined outputs spendable+ RPC.generateToAddress 100 textAddr2 Nothing++ let Right (tx, vFund) = spendPackageOutputs inputs addr vTarget+ h <- RPC.sendRawTransaction (encodeHex $ S.encode tx) Nothing+ RPC.generateToAddress 6 textAddr2 Nothing++ return (OutPoint h 0, vFund)+++generateEnoughBlocks :: Word64 -> BitcoindClient [(OutPoint, Word64)]+generateEnoughBlocks vTarget = go ([], 0, 0 :: Int)+ where+ go (xs, v, n)+ | n >= 100 = return xs+ | otherwise = do+ x@(_, v0) <- generate+ let xs' = x : xs+ if v + v0 >= vTarget+ then return xs'+ 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.+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)+++-- | Spend outputs created by 'generate'+spendPackageOutputs+ :: [(OutPoint, Word64)]+ -- ^ outputs produced by 'generate'+ -> Address+ -- ^ recipient address+ -> Word64+ -- ^ amount to spend+ -> 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)++ | otherwise+ = Left "Insufficient funds"++ 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]+ 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+++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+++textAddr0, textAddr1, textAddr2 :: Text+textAddr0 : textAddr1 : textAddr2 : _ = textAddrs
+ test/Main.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE NumericUnderscores #-}+{-# 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+++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+ ]+++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+++testBlock :: BitcoindClient Block+testBlock = getBestBlockHash >>= getBlock+++testBlockHeader :: BitcoindClient BlockHeader+testBlockHeader = getBestBlockHash >>= getBlockHeader+++testBlockStats :: BitcoindClient BlockStats+testBlockStats = getBestBlockHash >>= getBlockStats+++testGetTransaction :: BitcoindClient Tx+testGetTransaction+ = getBestBlockHash >>= getBlock >>= (`getTransaction` Nothing) . txHash . head . blockTxns+++testSendTransaction :: BitcoindClient TxHash+testSendTransaction = do+ outp <- head <$> replicateM 101 R.generate+ 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+ onFail e = assertFailure $ msg <> " - " <> show e