diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for bitcoind-regtest + +## 0.1.0.0 -- 2020-03-07 + +Initial release diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bitcoind-regtest.cabal b/bitcoind-regtest.cabal new file mode 100644 --- /dev/null +++ b/bitcoind-regtest.cabal @@ -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 diff --git a/src/Bitcoin/Core/Regtest.hs b/src/Bitcoin/Core/Regtest.hs new file mode 100644 --- /dev/null +++ b/src/Bitcoin/Core/Regtest.hs @@ -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 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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