network-bitcoin 1.8.3 → 1.9.1

raw patch · 9 files changed

+212/−74 lines, 9 filesdep +tastydep +tasty-quickcheckPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty, tasty-quickcheck

API changes (from Hackage documentation)

Files

• network-bitcoin.cabal +12/−12
• src/Network/Bitcoin.hs +7/−0
• src/Network/Bitcoin/BlockChain.hs +19/−7
• src/Network/Bitcoin/Internal.hs +7/−7
• src/Network/Bitcoin/Mining.hs +16/−7
• src/Network/Bitcoin/Net.hs +21/−0
• src/Network/Bitcoin/RawTransaction.hs +6/−6
• src/Network/Bitcoin/Wallet.hs +36/−7
• src/Test/Main.hs +88/−28

@@ -1,5 +1,5 @@ Name:                network-bitcoin-Version:             1.8.3+Version:             1.9.1 Synopsis:            An interface to bitcoind. Description:     This can be used to send Bitcoins, query balances, etc.  It@@ -9,26 +9,25 @@     > import Network.Bitcoin     >     > main = do-    >    balance <- getBalance auth+    >    client <- getClient "http://127.0.0.1:8332" "user" "password"+    >    balance <- getBalance client     >    putStrLn $ show balance ++ " BTC"-    >  where-    >    auth = Auth "http://127.0.0.1:8332" "user" "password"     .     To learn more about Bitcoin, see <http://www.bitcoin.org>. License:             BSD3 License-file:        LICENSE Author:              Michael Hendricks <michael@ndrix.org>                      Clark Gaebel <cgaebel@uwaterloo.ca>-Maintainer:          Clark Gaebel <cgaebel@uwaterloo.ca>-Homepage:            http://github.com/cgaebel/network-bitcoin-Bug-reports:         http://github.com/cgaebel/network-bitcoin/issues+Maintainer:          Matt Wraith <matt@bitnomial.com>+Homepage:            http://github.com/bitnomial/network-bitcoin+Bug-reports:         http://github.com/bitnomial/network-bitcoin/issues Copyright:           2012 Michael Hendricks <michael@ndrix.org>                      2013 Clark Gaebel <cgaebel@uwaterloo.ca> Stability:           experimental Category:            Network Build-type:          Simple Cabal-version:       >=1.8-tested-with:         GHC ==7.4.1, GHC ==7.6.2, GHC ==7.6.3+tested-with:         GHC ==8.4.3  Library   hs-source-dirs: src@@ -63,12 +62,11 @@  Source-repository head   type: git-  location: git://github.com/wowus/network-bitcoin.git+  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 +82,7 @@     base == 4.*,     time >= 1.4.2,     QuickCheck >= 2.6,+    tasty >= 1.0,+    tasty-quickcheck >= 0.10,     http-client >= 0.4.6,     network-bitcoin

@@ -30,6 +30,8 @@     , importPrivateKey     , dumpPrivateKey     -- * Mining Operations+    , generate+    , generateToAddress     , getGenerate     , setGenerate     , getHashesPerSec@@ -47,6 +49,9 @@     , getConnectionCount     , PeerInfo(..)     , getPeerInfo+    , AddNodeCommand(..)+    , addNode+    , disconnectNode     -- * Raw Transaction Operations     , RawTransaction     , getRawTransaction@@ -90,6 +95,8 @@     , moveBitcoins     , sendFromAccount     , sendMany+    , EstimationMode (..)+    , estimateSmartFee     -- , createMultiSig     , ReceivedByAddress(..)     , listReceivedByAddress

@@ -14,6 +14,7 @@                                   , setTransactionFee                                   , getRawMemoryPool                                   , BlockHash+                                  , BlockHeight                                   , getBlockHash                                   , Block(..)                                   , getBlock@@ -29,7 +30,7 @@ import           Network.Bitcoin.RawTransaction  -- | Returns the number of blocks in the longest block chain.-getBlockCount :: Client -> IO Integer+getBlockCount :: Client -> IO BlockHeight getBlockCount client = callApi client "getblockcount" []  -- | Returns the proof-of-work difficulty as a multiple of the minimum@@ -51,10 +52,11 @@  -- | The hash of a given block. type BlockHash = HexString+type BlockHeight = Integer  -- | Returns the hash of the block in best-block-chain at the given index. getBlockHash :: Client-             -> Integer -- ^ Block index.+             -> BlockHeight -- ^ Block index.              -> IO BlockHash getBlockHash client idx = callApi client "getblockhash" [ tj idx ] @@ -65,7 +67,7 @@                    -- | The size of the block.                    , blkSize          :: Integer                    -- | The "height" of the block. TODO: Clarify this.-                   , blkHeight        :: Integer+                   , blkHeight        :: BlockHeight                    -- | The version of the block.                    , blkVersion       :: Integer                    -- | The hash of the block at the root of the merkle tree@@ -79,7 +81,7 @@                    , blkNonce         :: Integer                    , blkBits          :: HexString                    -- | How hard was this block to mine?-                   , blkDifficulty    :: Integer+                   , blkDifficulty    :: Double                    -- | A pointer to the next block in the chain.                    , nextBlock        :: Maybe BlockHash                    -- | A pointer to the previous block in the chain.@@ -87,6 +89,13 @@                    }     deriving ( Show, Read, Ord, Eq ) +-- Missing from data type:+-- - strippedsize+-- - weight+-- - versionHex+-- - mediantime+-- - nTx+-- - chainwork instance FromJSON Block where     parseJSON (Object o) = Block <$> o .:  "hash"                                  <*> o .:  "confirmations"@@ -110,6 +119,8 @@ -- | Information on the unspent transaction in the output set. data OutputSetInfo =     OutputSetInfo { osiBestBlock       :: BlockHash+                  -- | The height of the best block chain+                  , osiHeight          :: BlockHeight                   -- | The number of transactions in the output set.                   , numTransactions    :: Integer                   -- | The number of outputs for the transactions.@@ -121,6 +132,7 @@  instance FromJSON OutputSetInfo where     parseJSON (Object o) = OutputSetInfo <$> o .: "bestblock"+                                         <*> o .: "height"                                          <*> o .: "transactions"                                          <*> o .: "txouts"                                          <*> o .: "bytes_serialized"@@ -140,7 +152,7 @@                -- | The public key of the sender.                , oiScriptPubKey  :: ScriptPubKey                -- | The version of this transaction.-               , oiVersion       :: Integer+               , oiVersion       :: Maybe Integer                -- | Is this transaction part of the coin base?                , oiCoinBase      :: Bool                }@@ -151,7 +163,7 @@                                       <*> o .: "confirmations"                                       <*> o .: "value"                                       <*> o .: "scriptPubKey"-                                      <*> o .: "version"+                                      <*> o .:? "version"                                       <*> o .: "coinbase"     parseJSON _ = mzero @@ -159,5 +171,5 @@ getOutputInfo :: Client               -> TransactionID               -> Integer -- ^ The index we're looking at.-              -> IO OutputInfo+              -> IO (Maybe OutputInfo) getOutputInfo client txid n = callApi client "gettxout" [ tj txid, tj n ]

@@ -72,7 +72,7 @@           -> BS.ByteString           -> IO Client getClient url user pass = do-    url' <- parseUrl url+    url' <- parseUrlThrow url     mgr <- newManager defaultManagerSettings     let baseReq = applyBasicAuth user pass url'             { method = "POST"@@ -101,9 +101,9 @@ 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@@ -116,18 +116,18 @@ {-# INLINE callApi #-}  -- | Used to allow "null" to decode to a tuple.-data Nil = Nil { unNil :: () }+newtype Nil = Nil { unNil :: () }  instance FromJSON Nil where     parseJSON Null = return $ Nil ()     parseJSON x    = fail $ "\"null\" was expected, but " ++ show x ++ " was recieved."  -- | Used to parse "null" or [HexString]-data NilOrArray = NilOrArray {unArr :: Maybe [HexString]}+newtype NilOrArray = NilOrArray {unArr :: Maybe [HexString]}  instance FromJSON NilOrArray where     parseJSON Null = return $ NilOrArray Nothing-    parseJSON a@(Array _) = liftM NilOrArray $ parseJSON a+    parseJSON a@(Array _) = NilOrArray <$> parseJSON a     parseJSON x = fail $ "Expected \"null\" or array, but " ++ show x ++ " was recieved."  -- | A handy shortcut for toJSON, because I'm lazy.@@ -140,7 +140,7 @@ {-# INLINE tjm #-}  tja :: ToJSON a => Maybe a -> [Value]-tja m = fromMaybe [] $ pure . tj <$> m+tja = maybe [] (pure . tj) {-# INLINE tja #-}  -- | A wrapper for a vector of address:amount pairs. The RPC expects that as

@@ -31,9 +31,15 @@                               , submitBlock                               ) where +import           Control.Exception        (catch, throw) import           Control.Monad import           Data.Aeson               as A import           Network.Bitcoin.Internal+import           Network.Bitcoin.Wallet   (getNewAddress)+import           Network.HTTP.Client      (HttpException (..),+                                           HttpExceptionContent (..),+                                           responseStatus)+import           Network.HTTP.Types       (status500)  -- | Returns whether or not bitcoind is generating bitcoins. getGenerate :: Client -- ^ bitcoind RPC client@@ -70,10 +76,14 @@          -> IO [HexString] -- ^ An array containing the block header                            --   hashes of the generated blocks                            --   (may be empty if used with generate 0)-generate client blocks Nothing =-    callApi client "generate" [ tj blocks ]-generate client blocks (Just maxTries) =-    callApi client "generate" [ tj blocks, tj maxTries]+generate client blocks maxTries =+    callApi client "generate" args `catch` onFail+  where+    args = tj blocks : maybe [] (pure . tj) maxTries+    onFail (HttpExceptionRequest _ (StatusCodeException rsp _))+        | responseStatus rsp == status500+        = getNewAddress client Nothing >>= flip (generateToAddress client blocks) maxTries+    onFail e = throw e  -- | The generatetoaddress RPC mines blocks immediately to a specified address. --   See https://bitcoin.org/en/developer-reference#generatetoaddress for more details.@@ -189,8 +199,7 @@                                        <*> o .:  "sigops"     parseJSON _ = mzero -data CoinBaseAux = CoinBaseAux { cbFlags :: HexString-                               }+newtype CoinBaseAux = CoinBaseAux { cbFlags :: HexString }     deriving ( Show, Read, Ord, Eq )  instance FromJSON CoinBaseAux where@@ -255,7 +264,7 @@ --   the string "rejected" on failure. -- --   We use 'StupidReturnValue' to parse this ridiculous API.-data StupidReturnValue = SRV { unStupid :: Bool }+newtype StupidReturnValue = SRV { unStupid :: Bool }  instance FromJSON StupidReturnValue where     parseJSON Null = return $ SRV True

@@ -11,6 +11,9 @@                            , getConnectionCount                            , PeerInfo(..)                            , getPeerInfo+                           , AddNodeCommand(..)+                           , addNode+                           , disconnectNode                            ) where  import           Control.Monad@@ -70,3 +73,21 @@ -- | Returns data about all connected peer nodes. getPeerInfo :: Client -> IO [PeerInfo] getPeerInfo client = callApi client "getpeerinfo" []+++data AddNodeCommand = Add | Remove | OneTry+    deriving (Show, Read, Eq)+++instance ToJSON AddNodeCommand where+    toJSON Add    = String "add"+    toJSON Remove = String "remove"+    toJSON OneTry = String "onetry"+++addNode :: Client -> Text -> AddNodeCommand -> IO ()+addNode client url com = unNil <$> callApi client "addnode" [tj url, tj com]+++disconnectNode :: Client -> Maybe Text -> Maybe Int -> IO ()+disconnectNode client url nodeId = unNil <$> callApi client "disconnectnode" [tj url, tj nodeId]

@@ -51,7 +51,7 @@ getRawTransaction :: Client -> TransactionID -> IO RawTransaction getRawTransaction client txid =     callApi client "getrawtransaction" [ tj txid, tj verbose ]-        where verbose = 0 :: Int+        where verbose = False  -- | A transaction into an account. This can either be a coinbase transaction, --   or a standard transaction with another account.@@ -217,7 +217,7 @@ getRawTransactionInfo :: Client -> TransactionID -> IO RawTransactionInfo getRawTransactionInfo client txid =     callApi client "getrawtransaction" [ tj txid, tj verbose ]-        where verbose = 1 :: Int+        where verbose = True  data UnspentTransaction =     UnspentTransaction { unspentTransactionId :: TransactionID@@ -241,9 +241,9 @@  -- Instance used in 'createRawTransaction'. instance ToJSON UnspentTransaction where-    toJSON (UnspentTransaction{..}) = object [ "txid" .= unspentTransactionId-                                             , "vout" .= outIdx-                                             ]+    toJSON UnspentTransaction{..} = object [ "txid" .= unspentTransactionId+                                           , "vout" .= outIdx+                                           ]  -- | Returns an array of unspent transaction outputs with between minconf and --   maxconf (inclusive) confirmations. If addresses are given, the result will@@ -306,7 +306,7 @@ newtype UnspentForSigning = UFS UnspentTransaction  instance ToJSON UnspentForSigning where-    toJSON (UFS (UnspentTransaction{..}))+    toJSON (UFS UnspentTransaction{..})         | isNothing redeemScript =             object [ "txid" .= unspentTransactionId                    , "vout" .= outIdx

@@ -35,6 +35,8 @@                               , moveBitcoins                               , sendFromAccount                               , sendMany+                              , EstimationMode (..)+                              , estimateSmartFee                               -- , createMultiSig                               , ReceivedByAddress(..)                               , listReceivedByAddress@@ -63,13 +65,17 @@                               , isAddressValid                               ) where +import           Control.Exception              (throw) import           Control.Monad import           Data.Aeson                     as A+import           Data.Aeson.Types               (parseEither)+import qualified Data.ByteString.Lazy.Char8     as BSL8 import qualified Data.HashMap.Lazy              as HM import           Data.Maybe import           Data.Text import           Data.Time.Clock.POSIX import           Data.Vector                    as V hiding ((++))+import           Data.Word import           Network.Bitcoin.BlockChain     (BlockHash) import           Network.Bitcoin.Internal import           Network.Bitcoin.RawTransaction (RawTransaction)@@ -129,6 +135,8 @@     parseJSON _ = mzero  -- | Returns an object containing various state info.+--+-- /Availability:/ @< 0.16@ getBitcoindInfo :: Client -> IO BitcoindInfo getBitcoindInfo client = callApi client "getinfo" [] @@ -357,7 +365,7 @@  instance FromJSON ReceivedByAddress where     parseJSON (Object o) = ReceivedByAddress <$> o .: "address"-                                             <*> o .: "account"+                                             <*> o .: "label"                                              <*> o .: "amount"                                              <*> o .: "confirmations"     parseJSON _ = mzero@@ -531,9 +539,9 @@                --   transaction can be returned as 'sbLastBlockHash'. This does                --   not in any way affect which transactions are returned                --   (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952)-               -> IO (SinceBlock)-listSinceBlock client blockHash conf =-    listSinceBlock' client (Just blockHash) conf+               -> IO SinceBlock+listSinceBlock client blockHash =+    listSinceBlock' client (Just blockHash)  -- | Gets all transactions in blocks since the given block, or all --   transactions if ommited.@@ -545,7 +553,7 @@                 --   transaction can be returned as 'sbLastBlockHash'. This does                 --   not in any way affect which transactions are returned                 --   (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952)-                -> IO (SinceBlock)+                -> IO SinceBlock listSinceBlock' client mblockHash mminConf =     callApi client "listsinceblock" $ tja mblockHash ++ tja mminConf @@ -677,7 +685,7 @@  getTransaction :: Client                -> TransactionID-               -> IO (DetailedTransaction)+               -> IO DetailedTransaction getTransaction client txid =     callApi client "gettransaction" [ tj txid ] @@ -736,7 +744,7 @@  -- | Just a handy wrapper to help us get only the "isvalid" field of the JSON. --   The structure is much too complicated for what it needs to do.-data IsValid = IsValid { getValid :: Bool }+newtype IsValid = IsValid { getValid :: Bool }  instance FromJSON IsValid where     parseJSON (Object o) = IsValid <$> o .: "isvalid"@@ -745,3 +753,24 @@ -- | Checks if a given address is a valid one. isAddressValid :: Client -> Address -> IO Bool isAddressValid client addr = getValid <$> callApi client "validateaddress" [ tj addr ]+++-- | Possible fee estimation modes+data EstimationMode+    = Economical+    | Conservative+    deriving Eq+++instance ToJSON EstimationMode where+    toJSON Economical   = toJSON ("ECONOMICAL" :: String)+    toJSON Conservative = toJSON ("CONSERVATIVE" :: String)+++-- | Estimate the fee per kb to send a transaction+estimateSmartFee :: Client -> Word32 -> Maybe EstimationMode -> IO Double+estimateSmartFee client target mode =+    parse =<< callApi client "estimatesmartfee" (catMaybes [ Just $ tj target, tj <$> mode ])+    where+    parse = either (throw . BitcoinResultTypeError . BSL8.pack) pure . parseEither parseResp+    parseResp = withObject "estimatesmartfee response" (.: "feerate")

@@ -1,50 +1,110 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-} + module Main where  -import           Data.Vector             (empty)+import           Control.Monad            (void)+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 qualified Network.Bitcoin.Mining   as M import           Test.QuickCheck import           Test.QuickCheck.Monadic+import           Test.Tasty               (TestName, TestTree, defaultMain,+                                           testGroup)+import           Test.Tasty.QuickCheck   main :: IO ()-main = mapM_ qcOnce [ canGetInfo-                    , canListUnspent-                    , canGetOutputInfo-                    ]+main = defaultMain . testGroup "network-bitcoin tests" $+    [ canGenerateBlocks+    , 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  -canGetInfo :: Property-canGetInfo = monadicIO $ do-    info <- run $ getBitcoindInfo =<< client-    let checks = [ bitcoinVersion info > 80000-                 , onTestNetwork info-                 , bitcoindErrors info == ""-                 ]-    assert $ and checks+canGenerateBlocks :: TestTree+canGenerateBlocks = nbTest "generateToAddress" $ do+    void . run $ do+        c          <- client+        rewardAddr <- getNewAddress c Nothing+        M.generateToAddress c 101 rewardAddr Nothing+    assert True  -canListUnspent :: Property-canListUnspent = monadicIO $ do-    _ <- run $ (\c -> listUnspent c Nothing Nothing Data.Vector.empty) =<< client+canListUnspent :: TestTree+canListUnspent = nbTest "listUnspent" $ do+    void . run $ do+        c <- client+        listUnspent c Nothing Nothing Data.Vector.empty     assert True  -canGetOutputInfo :: Property-canGetOutputInfo = monadicIO $ do-    info <- run $ (\c-> getOutputInfo c "ab8e26fd95fa371ac15b43684d0c6797fb573757095e7d763ba86ad315f7db04" 1) =<< client-    _ <- run $ print info+getTopBlock :: Client -> IO Block+getTopBlock c = getBlockCount c >>= getBlockHash c >>= getBlock c+++canGetBlock :: TestTree+canGetBlock = nbTest "getBlockCount / getBlockHash / getBlock" $ do+    run $ client >>= getTopBlock     assert True+++canGetRawTransaction :: TestTree+canGetRawTransaction = nbTest "getRawTransactionInfo" $ do+    run $ do+        c <- client+        b <- getTopBlock c+        getRawTransactionInfo c (subTransactions b V.! 0)+    assert True+++canGetOutputInfo :: TestTree+canGetOutputInfo = nbTest "getOutputInfo" $ do+    run $ do+        c <- client+        b <- getTopBlock c+        getOutputInfo c (subTransactions b V.! 0) 0+    assert True+++canGetAddress :: TestTree+canGetAddress = nbTest "getNewAddress" $ do+    run $ do+        c <- client+        getNewAddress c Nothing+    assert True+++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 amt Nothing Nothing+        M.generate c 6 Nothing+        (addr,) <$> listReceivedByAddress c++    assert . V.elem (addr, amt) . fmap f $ recv+  where+    f = (,) <$> recvAddress <*> recvAmount