bitcoind-rpc 0.1.0.0 → 0.2.0.0

raw patch · 11 files changed

+709/−627 lines, 11 filesdep +base16-bytestringdep +bitcoin-compact-filtersdep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: base16-bytestring, bitcoin-compact-filters

Dependency ranges changed: aeson, base, bytestring, haskoin-core, http-client, servant, servant-client, servant-jsonrpc-client, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• LICENSE +28/−0
• bitcoind-rpc.cabal +17/−12
• src/Bitcoin/Core/RPC.hs +114/−111
• src/Bitcoin/Core/RPC/Blockchain.hs +188/−141
• src/Bitcoin/Core/RPC/Control.hs +19/−19
• src/Bitcoin/Core/RPC/Generating.hs +27/−23
• src/Bitcoin/Core/RPC/Network.hs +126/−130
• src/Bitcoin/Core/RPC/Responses.hs +19/−18
• src/Bitcoin/Core/RPC/Transactions.hs +52/−48
• src/Servant/Bitcoind.hs +113/−125

@@ -1,5 +1,11 @@ # Revision history for bitcoind-rpc +## 0.2.0.0 -- 2020-11-01 ++* Define our own `BlockHeader` type instead of using the one from `haskoin-core`+* Refactor code to deal with new `aeson` instance definitions in `haskoin-core 0.13.5`+* Adds `getBlockFilter` for fetching BIP 157 filters+ ## 0.1.0.0 -- 2020-03-07  Initial release

@@ -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.

@@ -1,9 +1,11 @@ cabal-version:      2.2 name:               bitcoind-rpc-version:            0.1.0.0+version:            0.2.0.0 synopsis:           A streamlined interface to bitcoin core using Haskoin types and Servant-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@@ -27,16 +29,19 @@         Servant.Bitcoind      build-depends:-          aeson                         ^>=1.4-        , base                          ^>=4.12-        , bytestring                    ^>=0.10+          aeson                          >=1.4      && <1.6+        , base                           >=4.12     && <4.15+        , bytestring                     >=0.10     && <0.12+        , base16-bytestring               <1.0+        -- ^^ needed due to missing upper bound in haskoin-core+        , bitcoin-compact-filters       ^>=0.1         , cereal                        ^>=0.5-        , haskoin-core                   >=0.9      && <0.12-        , http-client                   ^>=0.6+        , haskoin-core                   >=0.13.5   && <0.18+        , http-client                    >=0.6      && <0.8         , scientific                    ^>=0.3-        , servant                        >=0.15     && <0.18-        , servant-client                 >=0.15     && <0.18-        , servant-jsonrpc-client        ^>=1.0+        , servant                        >=0.15     && <0.19+        , servant-client                 >=0.15     && <0.19+        , servant-jsonrpc-client         >=1.0      && <1.2         , text                          ^>=1.2-        , time                           >=1.8      && <1.10+        , time                           >=1.8      && <1.12         , transformers                  ^>=0.5

@@ -1,140 +1,143 @@--- |--- Module:      Bitcoin.Core.RPC--- Stability:   experimental------ We provide limited access to the bitcoin-core daemon RPC interface.  RPC--- method descriptions come from the bitcoind RPC help pages.-module Bitcoin.Core.RPC-    (+{- |+ Module:      Bitcoin.Core.RPC+ Stability:   experimental++ We provide limited access to the bitcoin-core daemon RPC interface.  RPC+ method descriptions come from the bitcoind RPC help pages.+-}+module Bitcoin.Core.RPC (     -- * Interacting with bitcoind-      BitcoindClient-    , runBitcoind-    , cookieClient-    , basicAuthFromCookie-    , mkBitcoindEnv-    , BitcoindException (..)+    BitcoindClient,+    runBitcoind,+    cookieClient,+    basicAuthFromCookie,+    mkBitcoindEnv,+    BitcoindException (..),      -- * Transactions-    , getTransaction-    , sendRawTransaction-    , sendTransaction-    , testMempoolAccept+    getTransaction,+    sendRawTransaction,+    sendTransaction,+    testMempoolAccept,      -- * Blocks-    , getBlock-    , getBlockHeader-    , getBlockHash-    , getBlockCount-    , getDifficulty--    , getBestBlockHash-    , getBlockStats-    , getChainTips-    , getChainTxStats+    getBlock,+    getBlockFilter,+    getBlockHeader,+    getBlockHash,+    getBlockCount,+    getDifficulty,+    getBestBlockHash,+    getBlockStats,+    getChainTips,+    getChainTxStats,      -- * Mempool-    , getMempoolInfo-    , getMempoolAncestors-    , getMempoolDescendants-    , getRawMempool+    getMempoolInfo,+    getMempoolAncestors,+    getMempoolDescendants,+    getRawMempool,      -- * Network-    , getPeerInfo-    , getConnectionCount-    , getNodeAddresses-    , getAddedNodeInfo-    , listBanned-    , getNetTotals+    getPeerInfo,+    getConnectionCount,+    getNodeAddresses,+    getAddedNodeInfo,+    listBanned,+    getNetTotals,      -- * Control-    , stop-    , uptime-    , Command (..)-    , addNode-    , disconnectNode-    , clearBanned-    , generateToAddress+    stop,+    uptime,+    Command (..),+    addNode,+    disconnectNode,+    clearBanned,+    generateToAddress,      -- * Response models-    , module Bitcoin.Core.RPC.Responses-    ) where--import           Control.Monad                 (join)-import           Control.Monad.IO.Class        (liftIO)-import           Control.Monad.Trans.Except    (runExceptT)-import           Control.Monad.Trans.Reader    (runReaderT)-import           Data.Bifunctor                (first, second)-import qualified Data.ByteString               as BS-import qualified Data.ByteString.Char8         as BS8-import           Network.HTTP.Client           (Manager)-import           Servant.API                   (BasicAuthData (..))-import           Servant.Client                (BaseUrl (..), ClientEnv,-                                                ClientError, Scheme (..),-                                                mkClientEnv, runClientM)+    module Bitcoin.Core.RPC.Responses,+) where -import           Bitcoin.Core.RPC.Blockchain-import           Bitcoin.Core.RPC.Control-import           Bitcoin.Core.RPC.Generating-import           Bitcoin.Core.RPC.Network-import           Bitcoin.Core.RPC.Responses-import           Bitcoin.Core.RPC.Transactions-import           Servant.Bitcoind              (BitcoindClient,-                                                BitcoindException (..))+import Control.Monad (join)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Except (runExceptT)+import Control.Monad.Trans.Reader (runReaderT)+import Data.Bifunctor (first, second)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Network.HTTP.Client (Manager)+import Servant.API (BasicAuthData (..))+import Servant.Client (+    BaseUrl (..),+    ClientEnv,+    ClientError,+    Scheme (..),+    mkClientEnv,+    runClientM,+ ) +import Bitcoin.Core.RPC.Blockchain+import Bitcoin.Core.RPC.Control+import Bitcoin.Core.RPC.Generating+import Bitcoin.Core.RPC.Network+import Bitcoin.Core.RPC.Responses+import Bitcoin.Core.RPC.Transactions+import Servant.Bitcoind (+    BitcoindClient,+    BitcoindException (..),+ )  -- | Convenience function for sending a RPC call to bitcoind-runBitcoind-    :: Manager-    -> String-    -- ^ host-    -> Int-    -- ^ port-    -> BasicAuthData-    -> BitcoindClient a-    -> IO (Either BitcoindException a)-runBitcoind mgr host port auth-    = fmap consolidateErrors . (`runClientM` env) . runExceptT . (`runReaderT` auth)-    where+runBitcoind ::+    Manager ->+    -- | host+    String ->+    -- | port+    Int ->+    BasicAuthData ->+    BitcoindClient a ->+    IO (Either BitcoindException a)+runBitcoind mgr host port auth =+    fmap consolidateErrors . (`runClientM` env) . runExceptT . (`runReaderT` auth)+  where     env = mkBitcoindEnv mgr host port - -- | Send a RPC call to bitcoind using credentials from a cookie file-cookieClient-    :: Manager-    -> FilePath-    -- ^ path to the cookie file-    -> String-    -- ^ host-    -> Int-    -- ^ port-    -> BitcoindClient r-    -> IO (Either BitcoindException r)-cookieClient mgr cookiePath host port go-    =   liftIO (basicAuthFromCookie cookiePath)-    >>= flip (runBitcoind mgr host port) go-+cookieClient ::+    Manager ->+    -- | path to the cookie file+    FilePath ->+    -- | host+    String ->+    -- | port+    Int ->+    BitcoindClient r ->+    IO (Either BitcoindException r)+cookieClient mgr cookiePath host port go =+    liftIO (basicAuthFromCookie cookiePath)+        >>= flip (runBitcoind mgr host port) go --- | Parse a username and password from a file.  The contents of the file--- should be exactly "username:password" (not base64 encoded).-basicAuthFromCookie-    :: FilePath-    -- ^ path to the cookie file-    -> IO BasicAuthData+{- | Parse a username and password from a file.  The contents of the file+ should be exactly "username:password" (not base64 encoded).+-}+basicAuthFromCookie ::+    -- | path to the cookie file+    FilePath ->+    IO BasicAuthData basicAuthFromCookie f = repack <$> BS.readFile f-    where+  where     repack = uncurry BasicAuthData . second (BS.drop 1) . BS8.break (== ':') - -- | Convenience function for connecting to bitcoind-mkBitcoindEnv-    :: Manager-    -> String-    -- ^ bitcoind host-    -> Int-    -- ^ bitcoind RPC port-    -> ClientEnv+mkBitcoindEnv ::+    Manager ->+    -- | bitcoind host+    String ->+    -- | bitcoind RPC port+    Int ->+    ClientEnv mkBitcoindEnv mgr host port = mkClientEnv mgr $ BaseUrl Http host port ""-  consolidateErrors :: Either ClientError (Either BitcoindException a) -> Either BitcoindException a consolidateErrors = join . first ClientException

@@ -1,74 +1,97 @@-{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications  #-}-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE TypeOperators     #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} -module Bitcoin.Core.RPC.Blockchain-    ( getBestBlockHash-    , getBlock-    , getBlockCount-    , getBlockHash-    , getBlockHeader-    , BlockStats (..)-    , getBlockStats-    , ChainTip (..)-    , ChainTipStatus (..)-    , getChainTips-    , ChainTxStats (..)-    , getChainTxStats-    , getDifficulty-    , getMempoolAncestors-    , getMempoolDescendants-    , MempoolInfo (..)-    , getMempoolInfo-    , getRawMempool-    ) where+module Bitcoin.Core.RPC.Blockchain (+    getBestBlockHash,+    getBlock,+    getBlockCount,+    getBlockHash,+    CompactFilter (..),+    getBlockFilter,+    BlockHeader (..),+    getBlockHeader,+    BlockStats (..),+    getBlockStats,+    ChainTip (..),+    ChainTipStatus (..),+    getChainTips,+    ChainTxStats (..),+    getChainTxStats,+    getDifficulty,+    getMempoolAncestors,+    getMempoolDescendants,+    MempoolInfo (..),+    getMempoolInfo,+    getRawMempool,+) where -import           Data.Aeson                  (FromJSON (..), withObject,-                                              withText, (.:), (.:?))-import           Data.Proxy                  (Proxy (..))-import           Data.Scientific             (Scientific)-import           Data.Text                   (Text)-import           Data.Time                   (NominalDiffTime, UTCTime)-import           Data.Word                   (Word16, Word32)-import           Network.Haskoin.Block       (Block, BlockHash, BlockHeader,-                                              BlockHeight)-import           Network.Haskoin.Transaction (TxHash)-import           Servant.API                 ((:<|>) (..))+import Bitcoin.CompactFilter (BlockFilter, BlockFilterHeader)+import Data.Aeson (+    FromJSON (..),+    withObject,+    withText,+    (.:),+    (.:?),+ )+import Data.Aeson.Types (Parser)+import Data.Proxy (Proxy (..))+import Data.Scientific (Scientific)+import Data.Serialize (Serialize)+import Data.Text (Text)+import Data.Time (NominalDiffTime, UTCTime)+import Data.Word (Word16, Word32, Word64)+import Haskoin.Block (Block, BlockHash, BlockHeight)+import Haskoin.Crypto (Hash256)+import Haskoin.Transaction (TxHash)+import Servant.API ((:<|>) (..)) -import           Servant.Bitcoind            (BitcoindClient, BitcoindEndpoint,-                                              C, DefFalse, DefZero, F, I, O,-                                              toBitcoindClient, toSatoshis,-                                              utcTime)+import Servant.Bitcoind (+    BitcoindClient,+    BitcoindEndpoint,+    C,+    DefFalse,+    DefTrue,+    DefZero,+    F,+    HexEncoded (..),+    I,+    O,+    decodeFromHex,+    toBitcoindClient,+    toSatoshis,+    utcTime,+ )  data BlockStats = BlockStats-    { blockStatsAvgFee             :: Double-    , blockStatsAvgFeeRate         :: Word32-    , blockStatsAvgTxSize          :: Word32-    , blockStatsBlockHash          :: BlockHash+    { blockStatsAvgFee :: Double+    , blockStatsAvgFeeRate :: Word32+    , blockStatsAvgTxSize :: Word32+    , blockStatsBlockHash :: BlockHash     , blockStatsFeeRatePercentiles :: [Word32]-    , blockStatsHeight             :: BlockHeight-    , blockStatsIns                :: Word32-    , blockStatsMaxFee             :: Word32-    , blockStatsMaxFeeRate         :: Word32-    , blockStatsMinTxSize          :: Word32-    , blockStatsOuts               :: Word32-    , blockStatsSubsidy            :: Word32-    , blockStatsSegwitSize         :: Word32-    , blockStastSegwitWeight       :: Word32-    , blockStatsSegwitCount        :: Word32-    , blockStatsTime               :: UTCTime-    , blockStatsTotalOut           :: Word32-    , blockStatsTotalSize          :: Word32-    , blockStatsTotalWeight        :: Word32-    , blockStatsTotalFee           :: Word32-    , blockStatsCount              :: Word32-    , blockStatsUtxoIncrease       :: Int-    , blockStatsUtxoSizeIncrease   :: Int-    } deriving (Eq, Show)-+    , blockStatsHeight :: BlockHeight+    , blockStatsIns :: Word32+    , blockStatsMaxFee :: Word32+    , blockStatsMaxFeeRate :: Word32+    , blockStatsMinTxSize :: Word32+    , blockStatsOuts :: Word32+    , blockStatsSubsidy :: Word32+    , blockStatsSegwitSize :: Word32+    , blockStastSegwitWeight :: Word32+    , blockStatsSegwitCount :: Word32+    , blockStatsTime :: UTCTime+    , blockStatsTotalOut :: Word32+    , blockStatsTotalSize :: Word32+    , blockStatsTotalWeight :: Word32+    , blockStatsTotalFee :: Word32+    , blockStatsCount :: Word32+    , blockStatsUtxoIncrease :: Int+    , blockStatsUtxoSizeIncrease :: Int+    }+    deriving (Eq, Show)  instance FromJSON BlockStats where     parseJSON = withObject "BlockStats" $ \o ->@@ -97,72 +120,105 @@             <*> o .: "utxo_increase"             <*> o .: "utxo_size_inc" +data CompactFilter = CompactFilter+    { filterHeader :: BlockFilterHeader+    , filterBody :: BlockFilter+    } +instance FromJSON CompactFilter where+    parseJSON = withObject "CompactFilter" $ \o ->+        CompactFilter+            <$> (o .: "header" >>= parseFromHex)+            <*> (o .: "filter" >>= parseFromHex)++data BlockHeader = BlockHeader+    { blockHeaderHash :: BlockHash+    , blockHeaderConfs :: Word32+    , blockHeaderHeight :: BlockHeight+    , blockHeaderMerkleRoot :: Hash256+    , blockHeaderTime :: UTCTime+    , blockHeaderMedianTime :: UTCTime+    , blockHeaderNonce :: Word64+    , blockHeaderTxCount :: Int+    , blockHeaderPrevHash :: Hash256+    }++instance FromJSON BlockHeader where+    parseJSON = withObject "BlockHeader" $ \o ->+        BlockHeader+            <$> o .: "hash"+            <*> o .: "confirmations"+            <*> o .: "height"+            <*> (o .: "merkleroot" >>= parseFromHex)+            <*> (utcTime <$> o .: "time")+            <*> (utcTime <$> o .: "mediantime")+            <*> o .: "nonce"+            <*> o .: "nTx"+            <*> (o .: "previousblockhash" >>= parseFromHex)++parseFromHex :: Serialize a => Text -> Parser a+parseFromHex = either fail return . decodeFromHex+ data ChainTipStatus = Invalid | HeadersOnly | ValidHeaders | ValidFork | Active     deriving (Eq, Show) - instance FromJSON ChainTipStatus where     parseJSON = withText "ChainTipStatus" chainTipStatus-        where+      where         chainTipStatus t-            | t == "invalid"       = return Invalid-            | t == "headers-only"  = return HeadersOnly+            | t == "invalid" = return Invalid+            | t == "headers-only" = return HeadersOnly             | t == "valid-headers" = return ValidHeaders-            | t == "valid-fork"    = return ValidFork-            | t == "active"        = return Active-            | otherwise            = fail "Unknown chain tip status"-+            | t == "valid-fork" = return ValidFork+            | t == "active" = return Active+            | otherwise = fail "Unknown chain tip status"  data ChainTip = ChainTip-    { tipHeight    :: Word32-    , tipHash      :: BlockHash+    { tipHeight :: Word32+    , tipHash :: BlockHash     , branchLength :: Word16-    , tipStatus    :: ChainTipStatus-    } deriving (Eq, Show)-+    , tipStatus :: ChainTipStatus+    }+    deriving (Eq, Show)  instance FromJSON ChainTip where     parseJSON = withObject "ChainTip" $ \o ->         ChainTip <$> o .: "height" <*> o .: "hash" <*> o .: "branchlen" <*> o .: "status" - data ChainTxStats = ChainTxStats-    { txStatsTime      :: UTCTime-    , txCount          :: Word32-    , finalBlockHash   :: BlockHash+    { txStatsTime :: UTCTime+    , txCount :: Word32+    , finalBlockHash :: BlockHash     , finalBlockHeight :: BlockHeight-    , finalBlockCount  :: Word32-    , windowTxCount    :: Maybe Word32-    , windowInterval   :: Maybe NominalDiffTime-    , txRate           :: Maybe Double-    } deriving (Eq, Show)-+    , finalBlockCount :: Word32+    , windowTxCount :: Maybe Word32+    , windowInterval :: Maybe NominalDiffTime+    , txRate :: Maybe Double+    }+    deriving (Eq, Show)  instance FromJSON ChainTxStats where     parseJSON = withObject "ChainTxStats" $ \o ->         ChainTxStats             <$> (utcTime <$> o .: "time")-            <*> o .:  "txcount"-            <*> o .:  "window_final_block_hash"-            <*> o .:  "window_final_block_height"-            <*> o .:  "window_block_count"+            <*> o .: "txcount"+            <*> o .: "window_final_block_hash"+            <*> o .: "window_final_block_height"+            <*> o .: "window_block_count"             <*> o .:? "window_tx_count"             <*> o .:? "window_interval"             <*> o .:? "txrate" -- data MempoolInfo = MempoolInfo-    { mempoolLoaded      :: Bool-    , mempoolSize        :: Word32-    , mempoolBytes       :: Word32-    , mempoolUsage       :: Word32-    , mempoolMax         :: Word32-    , mempoolMinFee      :: Word32+    { mempoolLoaded :: Bool+    , mempoolSize :: Word32+    , mempoolBytes :: Word32+    , mempoolUsage :: Word32+    , mempoolMax :: Word32+    , mempoolMinFee :: Word32     , mempoolMinRelayFee :: Word32-    } deriving (Eq, Show)-+    }+    deriving (Eq, Show)  instance FromJSON MempoolInfo where     parseJSON = withObject "MempoolInfo" $ \o ->@@ -175,78 +231,65 @@             <*> (toSatoshis <$> o .: "mempoolminfee")             <*> (toSatoshis <$> o .: "minrelaytxfee") --type BlockchainRpc-    =    BitcoindEndpoint "getbestblockhash" (C BlockHash)-    :<|> BitcoindEndpoint "getblock" (I BlockHash -> F DefZero Int -> C Block)-    :<|> BitcoindEndpoint "getblockcount" (C Word32)-    :<|> BitcoindEndpoint "getblockhash" (I BlockHeight -> C BlockHash)-    :<|> BitcoindEndpoint "getblockheader" (I BlockHash -> F DefFalse Bool -> C BlockHeader)-    :<|> BitcoindEndpoint "getblockstats" (I BlockHash -> O [Text] -> C BlockStats)-    :<|> BitcoindEndpoint "getchaintips" (C [ChainTip])-    :<|> BitcoindEndpoint "getchaintxstats" (O Word32 -> O BlockHash -> C ChainTxStats)-    :<|> BitcoindEndpoint "getdifficulty" (C Scientific)-    :<|> BitcoindEndpoint "getmempoolancestors" (I TxHash -> F DefFalse Bool -> C [TxHash])-    :<|> BitcoindEndpoint "getmempooldescendants" (I TxHash -> F DefFalse Bool -> C [TxHash])-    :<|> BitcoindEndpoint "getmempoolinfo" (C MempoolInfo)-    :<|> BitcoindEndpoint "getrawmempool" (F DefFalse Bool -> C [TxHash])-+type BlockchainRpc =+    BitcoindEndpoint "getbestblockhash" (C BlockHash)+        :<|> BitcoindEndpoint "getblock" (I BlockHash -> F DefZero Int -> C (HexEncoded Block))+        :<|> BitcoindEndpoint "getblockcount" (C Word32)+        :<|> BitcoindEndpoint "getblockfilter" (I BlockHash -> C CompactFilter)+        :<|> BitcoindEndpoint "getblockhash" (I BlockHeight -> C BlockHash)+        :<|> BitcoindEndpoint "getblockheader" (I BlockHash -> F DefTrue Bool -> C BlockHeader)+        :<|> BitcoindEndpoint "getblockstats" (I BlockHash -> O [Text] -> C BlockStats)+        :<|> BitcoindEndpoint "getchaintips" (C [ChainTip])+        :<|> BitcoindEndpoint "getchaintxstats" (O Word32 -> O BlockHash -> C ChainTxStats)+        :<|> BitcoindEndpoint "getdifficulty" (C Scientific)+        :<|> BitcoindEndpoint "getmempoolancestors" (I TxHash -> F DefFalse Bool -> C [TxHash])+        :<|> BitcoindEndpoint "getmempooldescendants" (I TxHash -> F DefFalse Bool -> C [TxHash])+        :<|> BitcoindEndpoint "getmempoolinfo" (C MempoolInfo)+        :<|> BitcoindEndpoint "getrawmempool" (F DefFalse Bool -> C [TxHash])  -- | Returns the hash of the best (tip) block in the most-work fully-validated chain. getBestBlockHash :: BitcoindClient BlockHash----- | Produce the block corresponding to the given 'BlockHash' if it exists.-getBlock :: BlockHash -> BitcoindClient Block-+getBlock' :: BlockHash -> BitcoindClient (HexEncoded Block)  -- | Returns the height of the most-work fully-validated chain.  The genesis block has height 0. getBlockCount :: BitcoindClient Word32 - -- | Returns hash of block in best-block-chain at height provided. getBlockHash :: BlockHeight -> BitcoindClient BlockHash +-- | Retrieve a BIP 157 content filter for a particular block.+getBlockFilter :: BlockHash -> BitcoindClient CompactFilter  -- | Returns the header of the block corresponding to the given 'BlockHash' getBlockHeader :: BlockHash -> BitcoindClient BlockHeader-- getBlockStats' :: BlockHash -> Maybe [Text] -> BitcoindClient BlockStats ---- | Return information about all known tips in the block tree, including the--- main chain as well as orphaned branches.+{- | Return information about all known tips in the block tree, including the+ main chain as well as orphaned branches.+-} getChainTips :: BitcoindClient [ChainTip] - -- | Compute statistics about the total number and rate of transactions in the chain. getChainTxStats :: Maybe Word32 -> Maybe BlockHash -> BitcoindClient ChainTxStats - -- | Returns the proof-of-work difficulty as a multiple of the minimum difficulty. getDifficulty :: BitcoindClient Scientific - -- | If txid is in the mempool, returns all in-mempool ancestors. getMempoolAncestors :: TxHash -> BitcoindClient [TxHash] - -- | If txid is in the mempool, returns all in-mempool descendants. getMempoolDescendants :: TxHash -> BitcoindClient [TxHash] - -- | Returns details on the active state of the TX memory pool. getMempoolInfo :: BitcoindClient MempoolInfo - -- | Returns all transaction ids in memory pool. getRawMempool :: BitcoindClient [TxHash]-- getBestBlockHash-    :<|> getBlock+    :<|> getBlock'     :<|> getBlockCount+    :<|> getBlockFilter     :<|> getBlockHash     :<|> getBlockHeader     :<|> getBlockStats'@@ -256,11 +299,15 @@     :<|> getMempoolAncestors     :<|> getMempoolDescendants     :<|> getMempoolInfo-    :<|> getRawMempool-    = toBitcoindClient $ Proxy @BlockchainRpc-+    :<|> getRawMempool =+        toBitcoindClient $ Proxy @BlockchainRpc --- | Compute per block statistics for a given window. All amounts are in--- satoshis.  It won't work for some heights with pruning.+{- | Compute per block statistics for a given window. All amounts are in+ satoshis.  It won't work for some heights with pruning.+-} getBlockStats :: BlockHash -> BitcoindClient BlockStats getBlockStats h = getBlockStats' h Nothing++-- | Produce the block corresponding to the given 'BlockHash' if it exists.+getBlock :: BlockHash -> BitcoindClient Block+getBlock = fmap unHexEncoded . getBlock'

@@ -1,31 +1,31 @@-{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators    #-}--module Bitcoin.Core.RPC.Control-    ( stop-    , uptime-    ) where--import           Data.Proxy       (Proxy (..))-import           Data.Word        (Word32)-import           Servant.API      ((:<|>) (..))+{-# LANGUAGE TypeOperators #-} -import           Servant.Bitcoind (BitcoindClient, BitcoindEndpoint, C, CX,-                                   toBitcoindClient)+module Bitcoin.Core.RPC.Control (+    stop,+    uptime,+) where +import Data.Proxy (Proxy (..))+import Data.Word (Word32)+import Servant.API ((:<|>) (..)) -type ControlRpc-    =    BitcoindEndpoint "stop" CX-    :<|> BitcoindEndpoint "uptime" (C Word32)+import Servant.Bitcoind (+    BitcoindClient,+    BitcoindEndpoint,+    C,+    CX,+    toBitcoindClient,+ ) +type ControlRpc =+    BitcoindEndpoint "stop" CX+        :<|> BitcoindEndpoint "uptime" (C Word32)  -- | Request a graceful shutdown of Bitcoin Core. stop :: BitcoindClient () - -- | Returns the total uptime of the server (in seconds) uptime :: BitcoindClient Word32-- stop :<|> uptime = toBitcoindClient $ Proxy @ControlRpc

@@ -1,32 +1,36 @@-{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications  #-}-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE TypeOperators     #-}--module Bitcoin.Core.RPC.Generating-    ( generateToAddress-    ) where+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} -import           Data.Proxy            (Proxy (..))-import           Data.Text             (Text)-import           Data.Word             (Word32)-import           Network.Haskoin.Block (BlockHash)+module Bitcoin.Core.RPC.Generating (+    generateToAddress,+) where -import           Servant.Bitcoind      (BitcoindClient, BitcoindEndpoint, C, I,-                                        O, toBitcoindClient)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Word (Word32)+import Haskoin.Block (BlockHash) +import Servant.Bitcoind (+    BitcoindClient,+    BitcoindEndpoint,+    C,+    I,+    O,+    toBitcoindClient,+ )  type GeneratingRpc = BitcoindEndpoint "generatetoaddress" (I Word32 -> I Text -> O Word32 -> C [BlockHash]) - -- | Generate blocks in @regtest@ mode-generateToAddress-  :: Word32-  -- ^ number of blocks to generate-  -> Text-  -- ^ address for the coinbase reward-  -> Maybe Word32-  -- ^ how many iterations to try-  -> BitcoindClient [BlockHash]+generateToAddress ::+    -- | number of blocks to generate+    Word32 ->+    -- | address for the coinbase reward+    Text ->+    -- | how many iterations to try+    Maybe Word32 ->+    BitcoindClient [BlockHash] generateToAddress = toBitcoindClient $ Proxy @GeneratingRpc

@@ -1,64 +1,73 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications  #-}-{-# LANGUAGE TypeOperators     #-}--module Bitcoin.Core.RPC.Network-    ( Command (..)-    , addNode-    , clearBanned-    , disconnectNode-    , NodeInfo (..)-    , NodeInfoAddress (..)-    , ConnDir (..)-    , getAddedNodeInfo-    , getConnectionCount-    , NetTotals (..)-    , getNetTotals-    , NodeAddress (..)-    , getNodeAddresses-    , PeerInfo (..)-    , getPeerInfo-    , listBanned-    ) where+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-} -import           Data.Aeson            (FromJSON (..), ToJSON (..), withObject,-                                        withText, (.:))-import           Data.Proxy            (Proxy (..))-import           Data.Text             (Text)-import           Data.Time             (NominalDiffTime, UTCTime)-import           Data.Word             (Word16, Word32, Word64)-import           Network.Haskoin.Block (BlockHeight)-import           Servant.API           ((:<|>) (..))+module Bitcoin.Core.RPC.Network (+    Command (..),+    addNode,+    clearBanned,+    disconnectNode,+    NodeInfo (..),+    NodeInfoAddress (..),+    ConnDir (..),+    getAddedNodeInfo,+    getConnectionCount,+    NetTotals (..),+    getNetTotals,+    NodeAddress (..),+    getNodeAddresses,+    PeerInfo (..),+    getPeerInfo,+    listBanned,+) where -import           Servant.Bitcoind      (BitcoindClient, BitcoindEndpoint, C, CX,-                                        I, O, toBitcoindClient, toSatoshis,-                                        utcTime)+import Data.Aeson (+    FromJSON (..),+    ToJSON (..),+    withObject,+    withText,+    (.:),+ )+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Time (NominalDiffTime, UTCTime)+import Data.Word (Word16, Word32, Word64)+import Haskoin.Block (BlockHeight)+import Servant.API ((:<|>) (..)) +import Servant.Bitcoind (+    BitcoindClient,+    BitcoindEndpoint,+    C,+    CX,+    I,+    O,+    toBitcoindClient,+    toSatoshis,+    utcTime,+ )  -- | Commands as understood by 'addNode' data Command = Add | Remove | OneTry deriving (Eq, Show, Enum) - commandText :: Command -> Text commandText = \case-    Add    -> "add"+    Add -> "add"     Remove -> "remove"     OneTry -> "onetry" - instance ToJSON Command where     toJSON = toJSON . commandText - data NodeAddress = NodeAddress-    { addrTime     :: UTCTime+    { addrTime :: UTCTime     , addrServices :: Word64-    , addrHost     :: Text-    , addrPort     :: Word32-    } deriving (Eq, Show)-+    , addrHost :: Text+    , addrPort :: Word32+    }+    deriving (Eq, Show)  instance FromJSON NodeAddress where     parseJSON = withObject "NodeAddress" $ \o ->@@ -68,79 +77,73 @@             <*> o .: "address"             <*> o .: "port" - data ConnDir = Inbound | Outbound deriving (Eq, Show, Enum) - instance FromJSON ConnDir where     parseJSON = withText "ConnDir" fromText-        where+      where         fromText t-            | t == "inbound"  = return Inbound+            | t == "inbound" = return Inbound             | t == "outbound" = return Outbound-            | otherwise       = fail "Unable to decode connection direction"-+            | otherwise = fail "Unable to decode connection direction"  data NodeInfoAddress = NodeInfoAddress     { nodeInfoAddress :: Text-    , connDirection   :: ConnDir-    } deriving (Eq, Show)-+    , connDirection :: ConnDir+    }+    deriving (Eq, Show)  instance FromJSON NodeInfoAddress where     parseJSON = withObject "NodeInfoAddress" $ \o ->         NodeInfoAddress <$> o .: "address" <*> o .: "connected" - data NodeInfo = NodeInfo     { addedNode :: Text     , connected :: Bool     , addresses :: [NodeInfoAddress]-    } deriving (Eq, Show)-+    }+    deriving (Eq, Show)  instance FromJSON NodeInfo where     parseJSON = withObject "NodeInfo" $ \o ->         NodeInfo <$> o .: "addednode" <*> o .: "connected" <*> o .: "addresses" - data NetTotals = NetTotals     { bytesReceived :: Word64-    , bytesSent     :: Word64-    } deriving (Eq, Show)-+    , bytesSent :: Word64+    }+    deriving (Eq, Show)  instance FromJSON NetTotals where     parseJSON = withObject "NetTotals" $ \o ->         NetTotals <$> o .: "totalbytesrecv" <*> o .: "totalbytessent" - data PeerInfo = PeerInfo-    { peerIndex      :: Word16-    , peerAddr       :: Text-    , peerBind       :: Text-    , services       :: Text-    , relay          :: Bool-    , lastSend       :: UTCTime-    , lastRecv       :: UTCTime-    , peerBytesSent  :: Word64-    , peerBytesRecv  :: Word64-    , connTime       :: UTCTime-    , timeOffset     :: NominalDiffTime-    , pingTime       :: Maybe Double-    , version        :: Word64-    , inbound        :: Bool-    , addnode        :: Bool+    { peerIndex :: Word16+    , peerAddr :: Text+    , peerBind :: Text+    , services :: Text+    , relay :: Bool+    , lastSend :: UTCTime+    , lastRecv :: UTCTime+    , peerBytesSent :: Word64+    , peerBytesRecv :: Word64+    , connTime :: UTCTime+    , timeOffset :: NominalDiffTime+    , pingTime :: Maybe Double+    , version :: Word64+    , inbound :: Bool+    , addnode :: Bool     , startingHeight :: BlockHeight-    , banScore       :: Word16-    , syncedHeaders  :: Word32-    , syncedBlocks   :: Word32-    , inflight       :: [BlockHeight]-    , whitelisted    :: Bool-    , minFeeFilter   :: Word32-    -- ^ in satoshis-    } deriving (Eq, Show)-+    , banScore :: Word16+    , syncedHeaders :: Word32+    , syncedBlocks :: Word32+    , inflight :: [BlockHeight]+    , whitelisted :: Bool+    , -- | in satoshis+      minFeeFilter :: Word32+    }+    deriving (Eq, Show)  instance FromJSON PeerInfo where     parseJSON = withObject "PeerInfo" $ \o ->@@ -168,70 +171,63 @@             <*> o .: "whitelisted"             <*> (toSatoshis <$> o .: "minfeefilter") --type NetworkRpc-    =    BitcoindEndpoint "addnode" (I Text -> I Command -> CX)-    :<|> BitcoindEndpoint "clearbanned" CX-    :<|> BitcoindEndpoint "disconnectnode" (I Text -> CX)-    :<|> BitcoindEndpoint "getaddednodeinfo" (O Text -> C [NodeInfo])-    :<|> BitcoindEndpoint "getconnectioncount" (C Word16)-    :<|> BitcoindEndpoint "getnettotals" (C NetTotals)-    :<|> BitcoindEndpoint "getnodeaddresses" (O Word32 -> C [NodeAddress])-    :<|> BitcoindEndpoint "getpeerinfo" (C [PeerInfo])-    :<|> BitcoindEndpoint "listbanned" (C [Text])----- | Attempts to add or remove a node from the addnode list; or try a--- connection to a node once.  Nodes added using addnode are protected from DoS--- disconnection and are not required to be full nodes/support SegWit as other--- outbound peers are (though such peers will not be synced from).-addNode-    :: Text-    -- ^ node address @host:port@-    -> Command-    -> BitcoindClient ()+type NetworkRpc =+    BitcoindEndpoint "addnode" (I Text -> I Command -> CX)+        :<|> BitcoindEndpoint "clearbanned" CX+        :<|> BitcoindEndpoint "disconnectnode" (I Text -> CX)+        :<|> BitcoindEndpoint "getaddednodeinfo" (O Text -> C [NodeInfo])+        :<|> BitcoindEndpoint "getconnectioncount" (C Word16)+        :<|> BitcoindEndpoint "getnettotals" (C NetTotals)+        :<|> BitcoindEndpoint "getnodeaddresses" (O Word32 -> C [NodeAddress])+        :<|> BitcoindEndpoint "getpeerinfo" (C [PeerInfo])+        :<|> BitcoindEndpoint "listbanned" (C [Text]) +{- | Attempts to add or remove a node from the addnode list; or try a+ connection to a node once.  Nodes added using addnode are protected from DoS+ disconnection and are not required to be full nodes/support SegWit as other+ outbound peers are (though such peers will not be synced from).+-}+addNode ::+    -- | node address @host:port@+    Text ->+    Command ->+    BitcoindClient ()  -- | Clear all banned IPs. clearBanned :: BitcoindClient () - -- | Immediately disconnects from the specified peer node.-disconnectNode-    :: Text-    -- ^ node address @host:port@-    -> BitcoindClient ()---- | Returns information about the given added node, or all added nodes (note--- that onetry addnodes are not listed here)-getAddedNodeInfo-    :: Maybe Text-    -- ^ optionally specify a node by address-    -> BitcoindClient [NodeInfo]+disconnectNode ::+    -- | node address @host:port@+    Text ->+    BitcoindClient () +{- | Returns information about the given added node, or all added nodes (note+ that onetry addnodes are not listed here)+-}+getAddedNodeInfo ::+    -- | optionally specify a node by address+    Maybe Text ->+    BitcoindClient [NodeInfo]  -- | Returns the number of connections to other nodes. getConnectionCount :: BitcoindClient Word16 ---- | Returns information about network traffic, including bytes in, bytes out,--- and current time.+{- | Returns information about network traffic, including bytes in, bytes out,+ and current time.+-} getNetTotals :: BitcoindClient NetTotals ---- | Return known addresses which can potentially be used to find new nodes in--- the network+{- | Return known addresses which can potentially be used to find new nodes in+ the network+-} getNodeAddresses :: Maybe Word32 -> BitcoindClient [NodeAddress] - -- | Returns data about each connected network node. getPeerInfo :: BitcoindClient [PeerInfo] - -- | List all banned IPs/Subnets. listBanned :: BitcoindClient [Text]-- addNode     :<|> clearBanned     :<|> disconnectNode@@ -240,5 +236,5 @@     :<|> getNetTotals     :<|> getNodeAddresses     :<|> getPeerInfo-    :<|> listBanned-    = toBitcoindClient $ Proxy @NetworkRpc+    :<|> listBanned =+        toBitcoindClient $ Proxy @NetworkRpc

@@ -1,26 +1,27 @@-module Bitcoin.Core.RPC.Responses-    (+module Bitcoin.Core.RPC.Responses (     -- * Transactions-      MempoolTestResult (..)+    MempoolTestResult (..),      -- * Blocks-    , BlockStats (..)-    , ChainTip (..)-    , ChainTipStatus (..)-    , ChainTxStats (..)+    CompactFilter (..),+    BlockHeader (..),+    BlockStats (..),+    ChainTip (..),+    ChainTipStatus (..),+    ChainTxStats (..),      -- * Mempool-    , MempoolInfo (..)+    MempoolInfo (..),      -- * Network-    , PeerInfo (..)-    , NodeAddress (..)-    , NodeInfo (..)-    , NodeInfoAddress (..)-    , ConnDir (..)-    , NetTotals (..)-    ) where+    PeerInfo (..),+    NodeAddress (..),+    NodeInfo (..),+    NodeInfoAddress (..),+    ConnDir (..),+    NetTotals (..),+) where -import           Bitcoin.Core.RPC.Blockchain-import           Bitcoin.Core.RPC.Network-import           Bitcoin.Core.RPC.Transactions+import Bitcoin.Core.RPC.Blockchain+import Bitcoin.Core.RPC.Network+import Bitcoin.Core.RPC.Transactions

@@ -1,71 +1,75 @@-{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications  #-}-{-# LANGUAGE TypeOperators     #-}--module Bitcoin.Core.RPC.Transactions-    ( getTransaction-    , sendRawTransaction-    , sendTransaction-    , MempoolTestResult (..)-    , testMempoolAccept-    ) where+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-} -import           Data.Aeson                  (FromJSON (..), withObject, (.:),-                                              (.:?))-import           Data.Proxy                  (Proxy (..))-import qualified Data.Serialize              as S-import           Data.Text                   (Text)-import           Network.Haskoin.Block       (BlockHash)-import           Network.Haskoin.Transaction (Tx, TxHash)-import           Network.Haskoin.Util        (encodeHex)-import           Servant.API                 ((:<|>) (..))+module Bitcoin.Core.RPC.Transactions (+    getTransaction,+    sendRawTransaction,+    sendTransaction,+    MempoolTestResult (..),+    testMempoolAccept,+) where -import           Servant.Bitcoind            (BitcoindClient, BitcoindEndpoint,-                                              C, DefFalse, F, I, O,-                                              toBitcoindClient)+import Data.Aeson (FromJSON (..), withObject, (.:), (.:?))+import Data.Proxy (Proxy (..))+import qualified Data.Serialize as S+import Data.Text (Text)+import Haskoin.Block (BlockHash)+import Haskoin.Transaction (Tx, TxHash)+import Haskoin.Util (encodeHex)+import Servant.API ((:<|>) (..)) +import Servant.Bitcoind (+    BitcoindClient,+    BitcoindEndpoint,+    C,+    DefFalse,+    F,+    HexEncoded (..),+    I,+    O,+    toBitcoindClient,+ )  data MempoolTestResult = MempoolTestResult-    { testTxid     :: TxHash-    , txAccepted   :: Bool+    { testTxid :: TxHash+    , txAccepted :: Bool     , rejectReason :: Maybe Text-    } deriving (Eq, Show)-+    }+    deriving (Eq, Show)  instance FromJSON MempoolTestResult where     parseJSON = withObject "MempoolTestResult" $ \o ->         MempoolTestResult <$> o .: "txid" <*> o .: "allowed" <*> o .:? "reject-reason" --type RawTxRpc-    =    BitcoindEndpoint "sendrawtransaction" (I Text -> O Double -> C TxHash)-    :<|> BitcoindEndpoint "getrawtransaction" (I TxHash -> F DefFalse Bool -> O BlockHash -> C Tx)-    :<|> BitcoindEndpoint "testmempoolaccept" (I [Tx] -> O Double -> C [MempoolTestResult])-+type RawTxRpc =+    BitcoindEndpoint "sendrawtransaction" (I Text -> O Double -> C TxHash)+        :<|> BitcoindEndpoint "getrawtransaction" (I TxHash -> F DefFalse Bool -> O BlockHash -> C (HexEncoded Tx))+        :<|> BitcoindEndpoint "testmempoolaccept" (I [Tx] -> O Double -> C [MempoolTestResult])  -- | Submit a raw transaction (serialized, hex-encoded) to local node and network. sendRawTransaction :: Text -> Maybe Double -> BitcoindClient TxHash - -- | A version of 'sendRawTransaction' that handles serialization sendTransaction :: Tx -> Maybe Double -> BitcoindClient TxHash sendTransaction = sendRawTransaction . encodeHex . S.encode ---- | By default this function only works for mempool transactions. When called--- with a blockhash argument, getrawtransaction will return the transaction if--- the specified block is available and the transaction is found in that block.--- When called without a blockhash argument, getrawtransaction will return the--- transaction if it is in the mempool, or if -txindex is enabled and the--- transaction is in a block in the blockchain.-getTransaction :: TxHash -> Maybe BlockHash -> BitcoindClient Tx-+getTransaction' :: TxHash -> Maybe BlockHash -> BitcoindClient (HexEncoded Tx) --- | Returns result of mempool acceptance tests indicating if the transactions--- would be accepted by mempool.  This checks if the transaction violates the--- consensus or policy rules.+{- | Returns result of mempool acceptance tests indicating if the transactions+ would be accepted by mempool.  This checks if the transaction violates the+ consensus or policy rules.+-} testMempoolAccept :: [Tx] -> Maybe Double -> BitcoindClient [MempoolTestResult]-+sendRawTransaction :<|> getTransaction' :<|> testMempoolAccept = toBitcoindClient $ Proxy @RawTxRpc -sendRawTransaction :<|> getTransaction :<|> testMempoolAccept = toBitcoindClient $ Proxy @RawTxRpc+{- | By default this function only works for mempool transactions. When called+ with a blockhash argument, getrawtransaction will return the transaction if+ the specified block is available and the transaction is found in that block.+ When called without a blockhash argument, getrawtransaction will return the+ transaction if it is in the mempool, or if -txindex is enabled and the+ transaction is in a block in the blockchain.+-}+getTransaction :: TxHash -> Maybe BlockHash -> BitcoindClient Tx+getTransaction h = fmap unHexEncoded . getTransaction' h

@@ -1,82 +1,87 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NumericUnderscores    #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} -module Servant.Bitcoind-    (+module Servant.Bitcoind (     -- * Bitcoind api endpoint DSL--      C-    , CX-    , F-    , I-    , O+    C,+    CX,+    F,+    I,+    O,      -- * Types related to defaulting--    , EmptyString-    , EmptyList-    , DefFalse-    , DefZero+    EmptyString,+    EmptyList,+    DefFalse,+    DefTrue,+    DefZero,      -- * Types related to the client--    , BitcoindClient-    , BitcoindEndpoint-    , BitcoindException (..)+    BitcoindClient,+    BitcoindEndpoint,+    BitcoindException (..),      -- * Client generation mechanism--    , HasBitcoindClient (..)-    , Rewrite (..)+    HasBitcoindClient (..),+    Rewrite (..),      -- * Utility functions-    , utcTime-    , toSatoshis-    ) where--import           Control.Exception          (Exception)-import           Control.Monad.Trans.Except (ExceptT (..))-import           Control.Monad.Trans.Reader (ReaderT (..))-import           Data.Aeson                 (FromJSON (..), ToJSON (..), Value)-import qualified Data.Aeson.Types           as Ae-import           Data.Bifunctor             (first)-import           Data.Proxy                 (Proxy (..))-import           Data.Scientific            (Scientific)-import           Data.Text                  (Text)-import           Data.Time                  (UTCTime)-import           Data.Time.Clock.POSIX      (posixSecondsToUTCTime)-import           Data.Word                  (Word32, Word64)-import           GHC.TypeLits               (KnownSymbol, Symbol)-import           Servant.API                ((:<|>) (..), (:>))-import           Servant.API.BasicAuth      (BasicAuth, BasicAuthData)-import           Servant.Client             (ClientError, ClientM, client)-import           Servant.Client.JsonRpc     (JsonRpc, JsonRpcErr (..),-                                             JsonRpcResponse (..))+    utcTime,+    toSatoshis,+    decodeFromHex,+    HexEncoded (..),+) where +import Control.Exception (Exception)+import Control.Monad ((>=>))+import Control.Monad.Trans.Except (ExceptT (..))+import Control.Monad.Trans.Reader (ReaderT (..))+import Data.Aeson (+    FromJSON (..),+    ToJSON (..),+    Value,+    withText,+ )+import qualified Data.Aeson.Types as Ae+import Data.Bifunctor (first)+import Data.Proxy (Proxy (..))+import Data.Scientific (Scientific)+import Data.Serialize (Serialize, decode)+import Data.Text (Text)+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Word (Word32, Word64)+import GHC.TypeLits (KnownSymbol, Symbol)+import Haskoin.Util (decodeHex)+import Servant.API ((:<|>) (..), (:>))+import Servant.API.BasicAuth (BasicAuth, BasicAuthData)+import Servant.Client (ClientError, ClientM, client)+import Servant.Client.JsonRpc (+    JsonRpc,+    JsonRpcErr (..),+    JsonRpcResponse (..),+ )  -- | Exceptions resulting from interacting with bitcoind data BitcoindException-    = RpcException String-    -- ^ The error message returned by bitcoind on failure+    = -- | The error message returned by bitcoind on failure+      RpcException String     | ClientException ClientError     | DecodingError String-    deriving Show-+    deriving (Show)  instance Exception BitcoindException - data BitcoindEndpoint (m :: Symbol) a - -- | A client returning @Either BitcoindException r@ data C r @@ -92,164 +97,147 @@ -- | An ordinary argument data I r - class HasDefault x a where     getDefault :: p x -> a - data EmptyString - instance HasDefault EmptyString Text where getDefault _ = "" - data DefFalse - instance HasDefault DefFalse Bool where getDefault _ = False +data DefTrue -data EmptyList+instance HasDefault DefTrue Bool where getDefault _ = True +data EmptyList  instance HasDefault EmptyList [a] where getDefault _ = [] - data DefZero - instance Num a => HasDefault DefZero a where getDefault _ = 0 - class HasBitcoindClient x where     type TheBitcoindClient x :: *     toBitcoindClient :: p x -> TheBitcoindClient x - instance-    (Rewrite a, RewriteFrom a ~ NakedClient, KnownSymbol m)-    => HasBitcoindClient (BitcoindEndpoint m a)+    (Rewrite a, RewriteFrom a ~ NakedClient, KnownSymbol m) =>+    HasBitcoindClient (BitcoindEndpoint m a)     where-     type TheBitcoindClient (BitcoindEndpoint m a) = RewriteTo a-    toBitcoindClient _-        = rewriteRpc (Proxy @a)-        . client-        $ Proxy @(BitcoindRpc m)-+    toBitcoindClient _ =+        rewriteRpc (Proxy @a)+            . client+            $ Proxy @(BitcoindRpc m)  instance-    (HasBitcoindClient x, HasBitcoindClient y)-    => HasBitcoindClient (x :<|> y)+    (HasBitcoindClient x, HasBitcoindClient y) =>+    HasBitcoindClient (x :<|> y)     where-     type TheBitcoindClient (x :<|> y) = TheBitcoindClient x :<|> TheBitcoindClient y     toBitcoindClient _ = toBitcoindClient (Proxy @x) :<|> toBitcoindClient (Proxy @y) --type BitcoindRpc m    = BasicAuth "bitcoind" () :> JsonRpc m [Value] String Value-+type BitcoindRpc m = BasicAuth "bitcoind" () :> JsonRpc m [Value] String Value  type BitcoindClient r = ReaderT BasicAuthData (ExceptT BitcoindException ClientM) r --type NakedClient-    =  BasicAuthData-    -> [Value]-    -> ClientM (JsonRpcResponse String Value)-+type NakedClient =+    BasicAuthData ->+    [Value] ->+    ClientM (JsonRpcResponse String Value) --- | Bitcoind uses JSON arrays to serialize parameters.  This typeclass--- describes a generic rewriting system, but we apply it here to transform--- clients of the form @BasicAuthData -> [Value] -> ClientM Value@ into curried--- functions with endpoint specific arguments.+{- | Bitcoind uses JSON arrays to serialize parameters.  This typeclass+ describes a generic rewriting system, but we apply it here to transform+ clients of the form @BasicAuthData -> [Value] -> ClientM Value@ into curried+ functions with endpoint specific arguments.+-} class Rewrite a where     type RewriteFrom a :: *-    type RewriteTo a   :: *+    type RewriteTo a :: *     rewriteRpc :: p a -> RewriteFrom a -> RewriteTo a - -- | Handle endpoints which do not have an expected return value instance Rewrite CX where     type RewriteFrom CX = NakedClient-    type RewriteTo   CX = BitcoindClient ()+    type RewriteTo CX = BitcoindClient ()      rewriteRpc _ f = ReaderT $ ExceptT . fmap repack . (`f` [])-        where+      where         repack = \case-            Ack _                       -> return ()+            Ack _ -> return ()             Errors _ (JsonRpcErr _ e _) -> Left $ RpcException e-            Result{}                    -> Left $ RpcException "Expecting ack; got result"-+            Result{} -> Left $ RpcException "Expecting ack; got result"  -- | Endpoints which simply return a value instance FromJSON r => Rewrite (C r) where     type RewriteFrom (C r) = NakedClient-    type RewriteTo   (C r) = BitcoindClient r+    type RewriteTo (C r) = BitcoindClient r      rewriteRpc _ f = ReaderT $ ExceptT . fmap repack . (`f` [])-        where+      where         repack = \case-            Result _ x                  -> first DecodingError $ Ae.parseEither parseJSON x+            Result _ x -> first DecodingError $ Ae.parseEither parseJSON x             Errors _ (JsonRpcErr _ e _) -> Left $ RpcException e-            Ack{}                       -> Left $ RpcException "Expecting result; got ack"-+            Ack{} -> Left $ RpcException "Expecting result; got ack"  -- | Add a normal argument instance-    (RewriteFrom b ~ NakedClient, Rewrite b, ToJSON a)-    => Rewrite (I a -> b)+    (RewriteFrom b ~ NakedClient, Rewrite b, ToJSON a) =>+    Rewrite (I a -> b)     where-     type RewriteFrom (I a -> b) = NakedClient-    type RewriteTo (I a -> b)   = a -> RewriteTo b+    type RewriteTo (I a -> b) = a -> RewriteTo b      rewriteRpc _ f x = rewriteRpc (Proxy @b) $ \auth args -> f auth (toJSON x : args) - -- | Add an optional argument instance-    (RewriteFrom b ~ NakedClient, Rewrite b, ToJSON a)-    => Rewrite (O a -> b)+    (RewriteFrom b ~ NakedClient, Rewrite b, ToJSON a) =>+    Rewrite (O a -> b)     where-     type RewriteFrom (O a -> b) = NakedClient-    type RewriteTo (O a -> b)   = Maybe a -> RewriteTo b+    type RewriteTo (O a -> b) = Maybe a -> RewriteTo b      rewriteRpc _ f x = rewriteRpc (Proxy @b) $ \auth args -> f auth ((toJSON <$> x) `maybeCons` args) - -- | Add a fixed argument instance-    (RewriteFrom b ~ NakedClient, Rewrite b, ToJSON a, HasDefault x a)-    => Rewrite (F x a -> b)+    (RewriteFrom b ~ NakedClient, Rewrite b, ToJSON a, HasDefault x a) =>+    Rewrite (F x a -> b)     where-     type RewriteFrom (F x a -> b) = NakedClient-    type RewriteTo   (F x a -> b) = RewriteTo b+    type RewriteTo (F x a -> b) = RewriteTo b      rewriteRpc _ f = rewriteRpc (Proxy @b) f'-        where+      where         f' auth args = f auth $ fixedVal : args         fixedVal = toJSON @a . getDefault $ Proxy @x -- instance (Rewrite a, Rewrite b) => Rewrite (a :<|> b) where     type RewriteFrom (a :<|> b) = RewriteFrom a :<|> RewriteFrom b-    type RewriteTo (a :<|> b)   = RewriteTo a :<|> RewriteTo b+    type RewriteTo (a :<|> b) = RewriteTo a :<|> RewriteTo b     rewriteRpc _ (x :<|> y) = rewriteRpc (Proxy @a) x :<|> rewriteRpc (Proxy @b) y - maybeCons :: Maybe a -> [a] -> [a]-maybeCons mx xs = maybe xs (:xs) mx-+maybeCons mx xs = maybe xs (: xs) mx  -- | Helper function for decoding POSIX timestamps utcTime :: Word64 -> UTCTime utcTime = posixSecondsToUTCTime . fromIntegral - -- | Convert BTC to Satoshis toSatoshis :: Scientific -> Word32 toSatoshis = floor . (* 100_000_000)++-- | Read a serializable from a hex string+decodeFromHex :: Serialize a => Text -> Either String a+decodeFromHex = maybe (Left "Invalid hex") Right . decodeHex >=> decode++newtype HexEncoded a = HexEncoded {unHexEncoded :: a} deriving (Eq, Show)++instance Serialize a => FromJSON (HexEncoded a) where+    parseJSON = withText "HexEncoded" $ either fail (return . HexEncoded) . decodeFromHex