diff --git a/README.md b/README.md index f30b2de..55cab71 100644 --- a/README.md +++ b/README.md @@ -6,8 +6,9 @@ See the [Hackage documentation](http://hackage.haskell.org/package/network-bitco Testing ---- -The tests expect to run against a `bitcoind` node synced to testnet. Invoke `bitcoind` with: +The tests expect to run against a `bitcoind` node running in regtest mode. +Invoke `bitcoind` with: ```shell -$ bitcoind -rpcuser -rpcpassword -testnet +$ bitcoind -regtest -rpcuser=bitcoinrpc -rpcpassword=bitcoinrpcpassword -rpcport=18444 ``` diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index a3f52c3..3967188 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -66,9 +66,8 @@ Source-repository head location: git://github.com/bitnomial/network-bitcoin.git Test-suite network-bitcoin-tests - hs-source-dirs: src - ghc-options: -Wall - main-is: Test/Main.hs + hs-source-dirs: src/Test + main-is: Main.hs type: exitcode-stdio-1.0 build-depends: aeson >= 0.8, @@ -84,5 +83,7 @@ Test-suite network-bitcoin-tests base == 4.*, time >= 1.4.2, QuickCheck >= 2.6, + tasty >= 1.0, + tasty-quickcheck >= 0.10, http-client >= 0.4.6, network-bitcoin diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 48ee4bf..e1bb73e 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -101,9 +101,9 @@ callApi :: FromJSON v callApi client cmd params = readVal =<< client jsonRpcReqBody where readVal bs = case decode' bs of - Just r@(BitcoinRpcResponse {btcError=NoError}) + Just r@BitcoinRpcResponse {btcError=NoError} -> return $ btcResult r - Just (BitcoinRpcResponse {btcError=BitcoinRpcError code msg}) + Just BitcoinRpcResponse {btcError=BitcoinRpcError code msg} -> throw $ BitcoinApiError code msg Nothing -> throw $ BitcoinResultTypeError bs diff --git a/src/Test/Main.hs b/src/Test/Main.hs index 253b516..b665c27 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -1,41 +1,47 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} + module Main where -import Data.Fixed (Fixed (MkFixed)) -import Data.Vector (empty) -import qualified Data.Vector as V +import Data.Either (isRight) +import Data.Text (Text) +import Data.Vector (empty) +import qualified Data.Vector as V import Network.Bitcoin +import Network.Bitcoin.Internal (callApi, tj) import Test.QuickCheck import Test.QuickCheck.Monadic +import Test.Tasty (TestName, TestTree, defaultMain, + testGroup) +import Test.Tasty.QuickCheck main :: IO () -main = mapM_ qcOnce [ canListUnspent - , canGetBlock - , canGetOutputInfo - , canGetRawTransaction - , canGetAddress - , canSendPayment - , canEstimateFees - ] +main = defaultMain . testGroup "network-bitcoin tests" $ + [ canListUnspent + , canGetBlock + , canGetOutputInfo + , canGetRawTransaction + , canGetAddress + , canSendPayment + ] -qcOnce :: Property -> IO () -qcOnce = quickCheckWith stdArgs { maxSuccess = 1 - , maxSize = 1 - , maxDiscardRatio = 1 - } +client :: IO Client +client = getClient "http://127.0.0.1:18444" "bitcoinrpc" "bitcoinrpcpassword" -client :: IO Client -client = getClient "http://127.0.0.1:18332" "bitcoinrpc" "bitcoinrpcpassword" +nbTest name = testProperty name . once . monadicIO -canListUnspent :: Property -canListUnspent = monadicIO $ do - _ <- run $ (\c -> listUnspent c Nothing Nothing Data.Vector.empty) =<< client +canListUnspent :: TestTree +canListUnspent = nbTest "listUnspent" $ do + _ <- run $ do + c <- client + listUnspent c Nothing Nothing Data.Vector.empty assert True @@ -43,51 +49,50 @@ getTopBlock :: Client -> IO Block getTopBlock c = getBlockCount c >>= getBlockHash c >>= getBlock c -canGetBlock :: Property -canGetBlock = monadicIO $ do - run $ client >>= - getTopBlock >>= - print - assert True +canGetBlock :: TestTree +canGetBlock = nbTest "getBlockCount / getBlockHash / getBlock" $ do + run $ client >>= getTopBlock + assert True -canGetRawTransaction :: Property -canGetRawTransaction = monadicIO $ do +canGetRawTransaction :: TestTree +canGetRawTransaction = nbTest "getRawTransactionInfo" $ do run $ do c <- client b <- getTopBlock c - getRawTransactionInfo c (subTransactions b V.! 0) >>= print + getRawTransactionInfo c (subTransactions b V.! 0) assert True -canGetOutputInfo :: Property -canGetOutputInfo = monadicIO $ do +canGetOutputInfo :: TestTree +canGetOutputInfo = nbTest "getOutputInfo" $ do run $ do c <- client b <- getTopBlock c - getOutputInfo c (subTransactions b V.! 0) 0 >>= print + getOutputInfo c (subTransactions b V.! 0) 0 assert True -canEstimateFees :: Property -canEstimateFees = monadicIO $ do - run $ client >>= \c -> - estimateSmartFee c 10 Nothing >>= print - assert True - - -canGetAddress :: Property -canGetAddress = monadicIO $ do +canGetAddress :: TestTree +canGetAddress = nbTest "getNewAddress" $ do run $ do c <- client - getNewAddress c Nothing >>= print + getNewAddress c Nothing assert True -canSendPayment :: Property -canSendPayment = monadicIO $ do - run $ do - c <- client +canSendPayment :: TestTree +canSendPayment = nbTest "send payment" $ do + c <- run client + bal <- run $ getBalance c + amt <- pick . suchThat arbitrary $ \x -> x < bal && x > 0 + + (addr, recv) <- run $ do addr <- getNewAddress c Nothing - sendToAddress c addr (MkFixed 10000000) Nothing Nothing >>= print - assert True + sendToAddress c addr amt Nothing Nothing + _ :: [Text] <- callApi c "generate" [ tj (2 :: Int) ] + (addr,) <$> listReceivedByAddress c + + assert . V.elem (addr, amt) . fmap f $ recv + where + f = (,) <$> recvAddress <*> recvAmount