{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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
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 Servant.Bitcoind (BitcoindClient, BitcoindEndpoint,
C, DefFalse, DefZero, F, I, O,
toBitcoindClient, toSatoshis,
utcTime)
data BlockStats = BlockStats
{ 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)
instance FromJSON BlockStats where
parseJSON = withObject "BlockStats" $ \o ->
BlockStats
<$> o .: "avgfee"
<*> o .: "avgfeerate"
<*> o .: "avgtxsize"
<*> o .: "blockhash"
<*> o .: "feerate_percentiles"
<*> o .: "height"
<*> o .: "ins"
<*> o .: "maxfee"
<*> o .: "maxfeerate"
<*> o .: "mintxsize"
<*> o .: "outs"
<*> o .: "subsidy"
<*> o .: "swtotal_size"
<*> o .: "swtotal_weight"
<*> o .: "swtxs"
<*> (utcTime <$> o .: "time")
<*> o .: "total_out"
<*> o .: "total_size"
<*> o .: "total_weight"
<*> o .: "totalfee"
<*> o .: "txs"
<*> o .: "utxo_increase"
<*> o .: "utxo_size_inc"
data ChainTipStatus = Invalid | HeadersOnly | ValidHeaders | ValidFork | Active
deriving (Eq, Show)
instance FromJSON ChainTipStatus where
parseJSON = withText "ChainTipStatus" chainTipStatus
where
chainTipStatus t
| 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"
data ChainTip = ChainTip
{ tipHeight :: Word32
, tipHash :: BlockHash
, branchLength :: Word16
, 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
, finalBlockHeight :: BlockHeight
, 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 .:? "window_tx_count"
<*> o .:? "window_interval"
<*> o .:? "txrate"
data MempoolInfo = MempoolInfo
{ mempoolLoaded :: Bool
, mempoolSize :: Word32
, mempoolBytes :: Word32
, mempoolUsage :: Word32
, mempoolMax :: Word32
, mempoolMinFee :: Word32
, mempoolMinRelayFee :: Word32
} deriving (Eq, Show)
instance FromJSON MempoolInfo where
parseJSON = withObject "MempoolInfo" $ \o ->
MempoolInfo
<$> o .: "loaded"
<*> o .: "size"
<*> o .: "bytes"
<*> o .: "usage"
<*> o .: "maxmempool"
<*> (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])
getBestBlockHash :: BitcoindClient BlockHash
getBlock :: BlockHash -> BitcoindClient Block
getBlockCount :: BitcoindClient Word32
getBlockHash :: BlockHeight -> BitcoindClient BlockHash
getBlockHeader :: BlockHash -> BitcoindClient BlockHeader
getBlockStats' :: BlockHash -> Maybe [Text] -> BitcoindClient BlockStats
getChainTips :: BitcoindClient [ChainTip]
getChainTxStats :: Maybe Word32 -> Maybe BlockHash -> BitcoindClient ChainTxStats
getDifficulty :: BitcoindClient Scientific
getMempoolAncestors :: TxHash -> BitcoindClient [TxHash]
getMempoolDescendants :: TxHash -> BitcoindClient [TxHash]
getMempoolInfo :: BitcoindClient MempoolInfo
getRawMempool :: BitcoindClient [TxHash]
getBestBlockHash
:<|> getBlock
:<|> getBlockCount
:<|> getBlockHash
:<|> getBlockHeader
:<|> getBlockStats'
:<|> getChainTips
:<|> getChainTxStats
:<|> getDifficulty
:<|> getMempoolAncestors
:<|> getMempoolDescendants
:<|> getMempoolInfo
:<|> getRawMempool
= toBitcoindClient $ Proxy @BlockchainRpc
getBlockStats :: BlockHash -> BitcoindClient BlockStats
getBlockStats h = getBlockStats' h Nothing