{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

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 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,
    DefTrue,
    DefZero,
    F,
    HexEncoded (..),
    I,
    O,
    decodeFromHex,
    toBitcoindClient,
    toSatoshis,
    utcTime,
 )

data BlockStats = BlockStats
    { BlockStats -> Double
blockStatsAvgFee :: Double
    , BlockStats -> Word32
blockStatsAvgFeeRate :: Word32
    , BlockStats -> Word32
blockStatsAvgTxSize :: Word32
    , BlockStats -> BlockHash
blockStatsBlockHash :: BlockHash
    , BlockStats -> [Word32]
blockStatsFeeRatePercentiles :: [Word32]
    , BlockStats -> Word32
blockStatsHeight :: BlockHeight
    , BlockStats -> Word32
blockStatsIns :: Word32
    , BlockStats -> Word32
blockStatsMaxFee :: Word32
    , BlockStats -> Word32
blockStatsMaxFeeRate :: Word32
    , BlockStats -> Word32
blockStatsMinTxSize :: Word32
    , BlockStats -> Word32
blockStatsOuts :: Word32
    , BlockStats -> Word32
blockStatsSubsidy :: Word32
    , BlockStats -> Word32
blockStatsSegwitSize :: Word32
    , BlockStats -> Word32
blockStastSegwitWeight :: Word32
    , BlockStats -> Word32
blockStatsSegwitCount :: Word32
    , BlockStats -> UTCTime
blockStatsTime :: UTCTime
    , BlockStats -> Word32
blockStatsTotalOut :: Word32
    , BlockStats -> Word32
blockStatsTotalSize :: Word32
    , BlockStats -> Word32
blockStatsTotalWeight :: Word32
    , BlockStats -> Word32
blockStatsTotalFee :: Word32
    , BlockStats -> Word32
blockStatsCount :: Word32
    , BlockStats -> Int
blockStatsUtxoIncrease :: Int
    , BlockStats -> Int
blockStatsUtxoSizeIncrease :: Int
    }
    deriving (BlockStats -> BlockStats -> Bool
(BlockStats -> BlockStats -> Bool)
-> (BlockStats -> BlockStats -> Bool) -> Eq BlockStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockStats -> BlockStats -> Bool
$c/= :: BlockStats -> BlockStats -> Bool
== :: BlockStats -> BlockStats -> Bool
$c== :: BlockStats -> BlockStats -> Bool
Eq, Int -> BlockStats -> ShowS
[BlockStats] -> ShowS
BlockStats -> String
(Int -> BlockStats -> ShowS)
-> (BlockStats -> String)
-> ([BlockStats] -> ShowS)
-> Show BlockStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockStats] -> ShowS
$cshowList :: [BlockStats] -> ShowS
show :: BlockStats -> String
$cshow :: BlockStats -> String
showsPrec :: Int -> BlockStats -> ShowS
$cshowsPrec :: Int -> BlockStats -> ShowS
Show)

instance FromJSON BlockStats where
    parseJSON :: Value -> Parser BlockStats
parseJSON = String
-> (Object -> Parser BlockStats) -> Value -> Parser BlockStats
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "BlockStats" ((Object -> Parser BlockStats) -> Value -> Parser BlockStats)
-> (Object -> Parser BlockStats) -> Value -> Parser BlockStats
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Double
-> Word32
-> Word32
-> BlockHash
-> [Word32]
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> UTCTime
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Int
-> Int
-> BlockStats
BlockStats
            (Double
 -> Word32
 -> Word32
 -> BlockHash
 -> [Word32]
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> UTCTime
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Int
 -> Int
 -> BlockStats)
-> Parser Double
-> Parser
     (Word32
      -> Word32
      -> BlockHash
      -> [Word32]
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "avgfee"
            Parser
  (Word32
   -> Word32
   -> BlockHash
   -> [Word32]
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> BlockHash
      -> [Word32]
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "avgfeerate"
            Parser
  (Word32
   -> BlockHash
   -> [Word32]
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (BlockHash
      -> [Word32]
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "avgtxsize"
            Parser
  (BlockHash
   -> [Word32]
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser BlockHash
-> Parser
     ([Word32]
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "blockhash"
            Parser
  ([Word32]
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser [Word32]
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Word32]
forall a. FromJSON a => Object -> Text -> Parser a
.: "feerate_percentiles"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "height"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "ins"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "maxfee"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "maxfeerate"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "mintxsize"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "outs"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "subsidy"
            Parser
  (Word32
   -> Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "swtotal_size"
            Parser
  (Word32
   -> Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32
      -> UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "swtotal_weight"
            Parser
  (Word32
   -> UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (UTCTime
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "swtxs"
            Parser
  (UTCTime
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser UTCTime
-> Parser
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Int
      -> Int
      -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> UTCTime
utcTime (Word64 -> UTCTime) -> Parser Word64 -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "time")
            Parser
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Int
   -> Int
   -> BlockStats)
-> Parser Word32
-> Parser
     (Word32 -> Word32 -> Word32 -> Word32 -> Int -> Int -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_out"
            Parser
  (Word32 -> Word32 -> Word32 -> Word32 -> Int -> Int -> BlockStats)
-> Parser Word32
-> Parser (Word32 -> Word32 -> Word32 -> Int -> Int -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_size"
            Parser (Word32 -> Word32 -> Word32 -> Int -> Int -> BlockStats)
-> Parser Word32
-> Parser (Word32 -> Word32 -> Int -> Int -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_weight"
            Parser (Word32 -> Word32 -> Int -> Int -> BlockStats)
-> Parser Word32 -> Parser (Word32 -> Int -> Int -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "totalfee"
            Parser (Word32 -> Int -> Int -> BlockStats)
-> Parser Word32 -> Parser (Int -> Int -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "txs"
            Parser (Int -> Int -> BlockStats)
-> Parser Int -> Parser (Int -> BlockStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "utxo_increase"
            Parser (Int -> BlockStats) -> Parser Int -> Parser BlockStats
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "utxo_size_inc"

data CompactFilter = CompactFilter
    { CompactFilter -> BlockFilterHeader
filterHeader :: BlockFilterHeader
    , CompactFilter -> BlockFilter
filterBody :: BlockFilter
    }

instance FromJSON CompactFilter where
    parseJSON :: Value -> Parser CompactFilter
parseJSON = String
-> (Object -> Parser CompactFilter)
-> Value
-> Parser CompactFilter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "CompactFilter" ((Object -> Parser CompactFilter) -> Value -> Parser CompactFilter)
-> (Object -> Parser CompactFilter)
-> Value
-> Parser CompactFilter
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        BlockFilterHeader -> BlockFilter -> CompactFilter
CompactFilter
            (BlockFilterHeader -> BlockFilter -> CompactFilter)
-> Parser BlockFilterHeader
-> Parser (BlockFilter -> CompactFilter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "header" Parser Text
-> (Text -> Parser BlockFilterHeader) -> Parser BlockFilterHeader
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser BlockFilterHeader
forall a. Serialize a => Text -> Parser a
parseFromHex)
            Parser (BlockFilter -> CompactFilter)
-> Parser BlockFilter -> Parser CompactFilter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "filter" Parser Text -> (Text -> Parser BlockFilter) -> Parser BlockFilter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser BlockFilter
forall a. Serialize a => Text -> Parser a
parseFromHex)

data BlockHeader = BlockHeader
    { BlockHeader -> BlockHash
blockHeaderHash :: BlockHash
    , BlockHeader -> Word32
blockHeaderConfs :: Word32
    , BlockHeader -> Word32
blockHeaderHeight :: BlockHeight
    , BlockHeader -> Hash256
blockHeaderMerkleRoot :: Hash256
    , BlockHeader -> UTCTime
blockHeaderTime :: UTCTime
    , BlockHeader -> UTCTime
blockHeaderMedianTime :: UTCTime
    , BlockHeader -> Word64
blockHeaderNonce :: Word64
    , BlockHeader -> Int
blockHeaderTxCount :: Int
    , BlockHeader -> Hash256
blockHeaderPrevHash :: Hash256
    }

instance FromJSON BlockHeader where
    parseJSON :: Value -> Parser BlockHeader
parseJSON = String
-> (Object -> Parser BlockHeader) -> Value -> Parser BlockHeader
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "BlockHeader" ((Object -> Parser BlockHeader) -> Value -> Parser BlockHeader)
-> (Object -> Parser BlockHeader) -> Value -> Parser BlockHeader
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        BlockHash
-> Word32
-> Word32
-> Hash256
-> UTCTime
-> UTCTime
-> Word64
-> Int
-> Hash256
-> BlockHeader
BlockHeader
            (BlockHash
 -> Word32
 -> Word32
 -> Hash256
 -> UTCTime
 -> UTCTime
 -> Word64
 -> Int
 -> Hash256
 -> BlockHeader)
-> Parser BlockHash
-> Parser
     (Word32
      -> Word32
      -> Hash256
      -> UTCTime
      -> UTCTime
      -> Word64
      -> Int
      -> Hash256
      -> BlockHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "hash"
            Parser
  (Word32
   -> Word32
   -> Hash256
   -> UTCTime
   -> UTCTime
   -> Word64
   -> Int
   -> Hash256
   -> BlockHeader)
-> Parser Word32
-> Parser
     (Word32
      -> Hash256
      -> UTCTime
      -> UTCTime
      -> Word64
      -> Int
      -> Hash256
      -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "confirmations"
            Parser
  (Word32
   -> Hash256
   -> UTCTime
   -> UTCTime
   -> Word64
   -> Int
   -> Hash256
   -> BlockHeader)
-> Parser Word32
-> Parser
     (Hash256
      -> UTCTime -> UTCTime -> Word64 -> Int -> Hash256 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "height"
            Parser
  (Hash256
   -> UTCTime -> UTCTime -> Word64 -> Int -> Hash256 -> BlockHeader)
-> Parser Hash256
-> Parser
     (UTCTime -> UTCTime -> Word64 -> Int -> Hash256 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "merkleroot" Parser Text -> (Text -> Parser Hash256) -> Parser Hash256
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Hash256
forall a. Serialize a => Text -> Parser a
parseFromHex)
            Parser
  (UTCTime -> UTCTime -> Word64 -> Int -> Hash256 -> BlockHeader)
-> Parser UTCTime
-> Parser (UTCTime -> Word64 -> Int -> Hash256 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> UTCTime
utcTime (Word64 -> UTCTime) -> Parser Word64 -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "time")
            Parser (UTCTime -> Word64 -> Int -> Hash256 -> BlockHeader)
-> Parser UTCTime
-> Parser (Word64 -> Int -> Hash256 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> UTCTime
utcTime (Word64 -> UTCTime) -> Parser Word64 -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "mediantime")
            Parser (Word64 -> Int -> Hash256 -> BlockHeader)
-> Parser Word64 -> Parser (Int -> Hash256 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "nonce"
            Parser (Int -> Hash256 -> BlockHeader)
-> Parser Int -> Parser (Hash256 -> BlockHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "nTx"
            Parser (Hash256 -> BlockHeader)
-> Parser Hash256 -> Parser BlockHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "previousblockhash" Parser Text -> (Text -> Parser Hash256) -> Parser Hash256
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Hash256
forall a. Serialize a => Text -> Parser a
parseFromHex)

parseFromHex :: Serialize a => Text -> Parser a
parseFromHex :: Text -> Parser a
parseFromHex = (String -> Parser a)
-> (a -> Parser a) -> Either String a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> Parser a)
-> (Text -> Either String a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String a
forall a. Serialize a => Text -> Either String a
decodeFromHex

data ChainTipStatus = Invalid | HeadersOnly | ValidHeaders | ValidFork | Active
    deriving (ChainTipStatus -> ChainTipStatus -> Bool
(ChainTipStatus -> ChainTipStatus -> Bool)
-> (ChainTipStatus -> ChainTipStatus -> Bool) -> Eq ChainTipStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainTipStatus -> ChainTipStatus -> Bool
$c/= :: ChainTipStatus -> ChainTipStatus -> Bool
== :: ChainTipStatus -> ChainTipStatus -> Bool
$c== :: ChainTipStatus -> ChainTipStatus -> Bool
Eq, Int -> ChainTipStatus -> ShowS
[ChainTipStatus] -> ShowS
ChainTipStatus -> String
(Int -> ChainTipStatus -> ShowS)
-> (ChainTipStatus -> String)
-> ([ChainTipStatus] -> ShowS)
-> Show ChainTipStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainTipStatus] -> ShowS
$cshowList :: [ChainTipStatus] -> ShowS
show :: ChainTipStatus -> String
$cshow :: ChainTipStatus -> String
showsPrec :: Int -> ChainTipStatus -> ShowS
$cshowsPrec :: Int -> ChainTipStatus -> ShowS
Show)

instance FromJSON ChainTipStatus where
    parseJSON :: Value -> Parser ChainTipStatus
parseJSON = String
-> (Text -> Parser ChainTipStatus)
-> Value
-> Parser ChainTipStatus
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "ChainTipStatus" Text -> Parser ChainTipStatus
forall a (m :: * -> *).
(Eq a, IsString a, MonadFail m) =>
a -> m ChainTipStatus
chainTipStatus
      where
        chainTipStatus :: a -> m ChainTipStatus
chainTipStatus t :: a
t
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "invalid" = ChainTipStatus -> m ChainTipStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ChainTipStatus
Invalid
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "headers-only" = ChainTipStatus -> m ChainTipStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ChainTipStatus
HeadersOnly
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "valid-headers" = ChainTipStatus -> m ChainTipStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ChainTipStatus
ValidHeaders
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "valid-fork" = ChainTipStatus -> m ChainTipStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ChainTipStatus
ValidFork
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "active" = ChainTipStatus -> m ChainTipStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ChainTipStatus
Active
            | Bool
otherwise = String -> m ChainTipStatus
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unknown chain tip status"

data ChainTip = ChainTip
    { ChainTip -> Word32
tipHeight :: Word32
    , ChainTip -> BlockHash
tipHash :: BlockHash
    , ChainTip -> Word16
branchLength :: Word16
    , ChainTip -> ChainTipStatus
tipStatus :: ChainTipStatus
    }
    deriving (ChainTip -> ChainTip -> Bool
(ChainTip -> ChainTip -> Bool)
-> (ChainTip -> ChainTip -> Bool) -> Eq ChainTip
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainTip -> ChainTip -> Bool
$c/= :: ChainTip -> ChainTip -> Bool
== :: ChainTip -> ChainTip -> Bool
$c== :: ChainTip -> ChainTip -> Bool
Eq, Int -> ChainTip -> ShowS
[ChainTip] -> ShowS
ChainTip -> String
(Int -> ChainTip -> ShowS)
-> (ChainTip -> String) -> ([ChainTip] -> ShowS) -> Show ChainTip
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainTip] -> ShowS
$cshowList :: [ChainTip] -> ShowS
show :: ChainTip -> String
$cshow :: ChainTip -> String
showsPrec :: Int -> ChainTip -> ShowS
$cshowsPrec :: Int -> ChainTip -> ShowS
Show)

instance FromJSON ChainTip where
    parseJSON :: Value -> Parser ChainTip
parseJSON = String -> (Object -> Parser ChainTip) -> Value -> Parser ChainTip
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "ChainTip" ((Object -> Parser ChainTip) -> Value -> Parser ChainTip)
-> (Object -> Parser ChainTip) -> Value -> Parser ChainTip
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Word32 -> BlockHash -> Word16 -> ChainTipStatus -> ChainTip
ChainTip (Word32 -> BlockHash -> Word16 -> ChainTipStatus -> ChainTip)
-> Parser Word32
-> Parser (BlockHash -> Word16 -> ChainTipStatus -> ChainTip)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "height" Parser (BlockHash -> Word16 -> ChainTipStatus -> ChainTip)
-> Parser BlockHash
-> Parser (Word16 -> ChainTipStatus -> ChainTip)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "hash" Parser (Word16 -> ChainTipStatus -> ChainTip)
-> Parser Word16 -> Parser (ChainTipStatus -> ChainTip)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word16
forall a. FromJSON a => Object -> Text -> Parser a
.: "branchlen" Parser (ChainTipStatus -> ChainTip)
-> Parser ChainTipStatus -> Parser ChainTip
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser ChainTipStatus
forall a. FromJSON a => Object -> Text -> Parser a
.: "status"

data ChainTxStats = ChainTxStats
    { ChainTxStats -> UTCTime
txStatsTime :: UTCTime
    , ChainTxStats -> Word32
txCount :: Word32
    , ChainTxStats -> BlockHash
finalBlockHash :: BlockHash
    , ChainTxStats -> Word32
finalBlockHeight :: BlockHeight
    , ChainTxStats -> Word32
finalBlockCount :: Word32
    , ChainTxStats -> Maybe Word32
windowTxCount :: Maybe Word32
    , ChainTxStats -> Maybe NominalDiffTime
windowInterval :: Maybe NominalDiffTime
    , ChainTxStats -> Maybe Double
txRate :: Maybe Double
    }
    deriving (ChainTxStats -> ChainTxStats -> Bool
(ChainTxStats -> ChainTxStats -> Bool)
-> (ChainTxStats -> ChainTxStats -> Bool) -> Eq ChainTxStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainTxStats -> ChainTxStats -> Bool
$c/= :: ChainTxStats -> ChainTxStats -> Bool
== :: ChainTxStats -> ChainTxStats -> Bool
$c== :: ChainTxStats -> ChainTxStats -> Bool
Eq, Int -> ChainTxStats -> ShowS
[ChainTxStats] -> ShowS
ChainTxStats -> String
(Int -> ChainTxStats -> ShowS)
-> (ChainTxStats -> String)
-> ([ChainTxStats] -> ShowS)
-> Show ChainTxStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainTxStats] -> ShowS
$cshowList :: [ChainTxStats] -> ShowS
show :: ChainTxStats -> String
$cshow :: ChainTxStats -> String
showsPrec :: Int -> ChainTxStats -> ShowS
$cshowsPrec :: Int -> ChainTxStats -> ShowS
Show)

instance FromJSON ChainTxStats where
    parseJSON :: Value -> Parser ChainTxStats
parseJSON = String
-> (Object -> Parser ChainTxStats) -> Value -> Parser ChainTxStats
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "ChainTxStats" ((Object -> Parser ChainTxStats) -> Value -> Parser ChainTxStats)
-> (Object -> Parser ChainTxStats) -> Value -> Parser ChainTxStats
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        UTCTime
-> Word32
-> BlockHash
-> Word32
-> Word32
-> Maybe Word32
-> Maybe NominalDiffTime
-> Maybe Double
-> ChainTxStats
ChainTxStats
            (UTCTime
 -> Word32
 -> BlockHash
 -> Word32
 -> Word32
 -> Maybe Word32
 -> Maybe NominalDiffTime
 -> Maybe Double
 -> ChainTxStats)
-> Parser UTCTime
-> Parser
     (Word32
      -> BlockHash
      -> Word32
      -> Word32
      -> Maybe Word32
      -> Maybe NominalDiffTime
      -> Maybe Double
      -> ChainTxStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> UTCTime
utcTime (Word64 -> UTCTime) -> Parser Word64 -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "time")
            Parser
  (Word32
   -> BlockHash
   -> Word32
   -> Word32
   -> Maybe Word32
   -> Maybe NominalDiffTime
   -> Maybe Double
   -> ChainTxStats)
-> Parser Word32
-> Parser
     (BlockHash
      -> Word32
      -> Word32
      -> Maybe Word32
      -> Maybe NominalDiffTime
      -> Maybe Double
      -> ChainTxStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "txcount"
            Parser
  (BlockHash
   -> Word32
   -> Word32
   -> Maybe Word32
   -> Maybe NominalDiffTime
   -> Maybe Double
   -> ChainTxStats)
-> Parser BlockHash
-> Parser
     (Word32
      -> Word32
      -> Maybe Word32
      -> Maybe NominalDiffTime
      -> Maybe Double
      -> ChainTxStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "window_final_block_hash"
            Parser
  (Word32
   -> Word32
   -> Maybe Word32
   -> Maybe NominalDiffTime
   -> Maybe Double
   -> ChainTxStats)
-> Parser Word32
-> Parser
     (Word32
      -> Maybe Word32
      -> Maybe NominalDiffTime
      -> Maybe Double
      -> ChainTxStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "window_final_block_height"
            Parser
  (Word32
   -> Maybe Word32
   -> Maybe NominalDiffTime
   -> Maybe Double
   -> ChainTxStats)
-> Parser Word32
-> Parser
     (Maybe Word32
      -> Maybe NominalDiffTime -> Maybe Double -> ChainTxStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "window_block_count"
            Parser
  (Maybe Word32
   -> Maybe NominalDiffTime -> Maybe Double -> ChainTxStats)
-> Parser (Maybe Word32)
-> Parser (Maybe NominalDiffTime -> Maybe Double -> ChainTxStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Word32)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "window_tx_count"
            Parser (Maybe NominalDiffTime -> Maybe Double -> ChainTxStats)
-> Parser (Maybe NominalDiffTime)
-> Parser (Maybe Double -> ChainTxStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe NominalDiffTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "window_interval"
            Parser (Maybe Double -> ChainTxStats)
-> Parser (Maybe Double) -> Parser ChainTxStats
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "txrate"

data MempoolInfo = MempoolInfo
    { MempoolInfo -> Bool
mempoolLoaded :: Bool
    , MempoolInfo -> Word32
mempoolSize :: Word32
    , MempoolInfo -> Word32
mempoolBytes :: Word32
    , MempoolInfo -> Word32
mempoolUsage :: Word32
    , MempoolInfo -> Word32
mempoolMax :: Word32
    , MempoolInfo -> Word32
mempoolMinFee :: Word32
    , MempoolInfo -> Word32
mempoolMinRelayFee :: Word32
    }
    deriving (MempoolInfo -> MempoolInfo -> Bool
(MempoolInfo -> MempoolInfo -> Bool)
-> (MempoolInfo -> MempoolInfo -> Bool) -> Eq MempoolInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MempoolInfo -> MempoolInfo -> Bool
$c/= :: MempoolInfo -> MempoolInfo -> Bool
== :: MempoolInfo -> MempoolInfo -> Bool
$c== :: MempoolInfo -> MempoolInfo -> Bool
Eq, Int -> MempoolInfo -> ShowS
[MempoolInfo] -> ShowS
MempoolInfo -> String
(Int -> MempoolInfo -> ShowS)
-> (MempoolInfo -> String)
-> ([MempoolInfo] -> ShowS)
-> Show MempoolInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MempoolInfo] -> ShowS
$cshowList :: [MempoolInfo] -> ShowS
show :: MempoolInfo -> String
$cshow :: MempoolInfo -> String
showsPrec :: Int -> MempoolInfo -> ShowS
$cshowsPrec :: Int -> MempoolInfo -> ShowS
Show)

instance FromJSON MempoolInfo where
    parseJSON :: Value -> Parser MempoolInfo
parseJSON = String
-> (Object -> Parser MempoolInfo) -> Value -> Parser MempoolInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "MempoolInfo" ((Object -> Parser MempoolInfo) -> Value -> Parser MempoolInfo)
-> (Object -> Parser MempoolInfo) -> Value -> Parser MempoolInfo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Bool
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> MempoolInfo
MempoolInfo
            (Bool
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> MempoolInfo)
-> Parser Bool
-> Parser
     (Word32
      -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> MempoolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "loaded"
            Parser
  (Word32
   -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> MempoolInfo)
-> Parser Word32
-> Parser
     (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> MempoolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "size"
            Parser
  (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> MempoolInfo)
-> Parser Word32
-> Parser (Word32 -> Word32 -> Word32 -> Word32 -> MempoolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "bytes"
            Parser (Word32 -> Word32 -> Word32 -> Word32 -> MempoolInfo)
-> Parser Word32
-> Parser (Word32 -> Word32 -> Word32 -> MempoolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "usage"
            Parser (Word32 -> Word32 -> Word32 -> MempoolInfo)
-> Parser Word32 -> Parser (Word32 -> Word32 -> MempoolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Word32
forall a. FromJSON a => Object -> Text -> Parser a
.: "maxmempool"
            Parser (Word32 -> Word32 -> MempoolInfo)
-> Parser Word32 -> Parser (Word32 -> MempoolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Scientific -> Word32
toSatoshis (Scientific -> Word32) -> Parser Scientific -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Scientific
forall a. FromJSON a => Object -> Text -> Parser a
.: "mempoolminfee")
            Parser (Word32 -> MempoolInfo)
-> Parser Word32 -> Parser MempoolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Scientific -> Word32
toSatoshis (Scientific -> Word32) -> Parser Scientific -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Scientific
forall a. FromJSON a => Object -> Text -> Parser a
.: "minrelaytxfee")

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
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.
-}
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 :: BitcoindClient BlockHash
getBestBlockHash
    :<|> getBlock' :: BlockHash -> BitcoindClient (HexEncoded Block)
getBlock'
    :<|> getBlockCount :: BitcoindClient Word32
getBlockCount
    :<|> getBlockFilter :: BlockHash -> BitcoindClient CompactFilter
getBlockFilter
    :<|> getBlockHash :: Word32 -> BitcoindClient BlockHash
getBlockHash
    :<|> getBlockHeader :: BlockHash -> BitcoindClient BlockHeader
getBlockHeader
    :<|> getBlockStats' :: BlockHash -> Maybe [Text] -> BitcoindClient BlockStats
getBlockStats'
    :<|> getChainTips :: BitcoindClient [ChainTip]
getChainTips
    :<|> getChainTxStats :: Maybe Word32 -> Maybe BlockHash -> BitcoindClient ChainTxStats
getChainTxStats
    :<|> getDifficulty :: BitcoindClient Scientific
getDifficulty
    :<|> getMempoolAncestors :: TxHash -> BitcoindClient [TxHash]
getMempoolAncestors
    :<|> getMempoolDescendants :: TxHash -> BitcoindClient [TxHash]
getMempoolDescendants
    :<|> getMempoolInfo :: BitcoindClient MempoolInfo
getMempoolInfo
    :<|> getRawMempool :: BitcoindClient [TxHash]
getRawMempool =
        Proxy BlockchainRpc
-> BitcoindClient BlockHash
   :<|> ((BlockHash -> BitcoindClient (HexEncoded Block))
         :<|> (BitcoindClient Word32
               :<|> ((BlockHash -> BitcoindClient CompactFilter)
                     :<|> ((Word32 -> BitcoindClient BlockHash)
                           :<|> ((BlockHash -> BitcoindClient BlockHeader)
                                 :<|> ((BlockHash -> Maybe [Text] -> BitcoindClient BlockStats)
                                       :<|> (BitcoindClient [ChainTip]
                                             :<|> ((Maybe Word32
                                                    -> Maybe BlockHash
                                                    -> BitcoindClient ChainTxStats)
                                                   :<|> (BitcoindClient Scientific
                                                         :<|> ((TxHash -> BitcoindClient [TxHash])
                                                               :<|> ((TxHash
                                                                      -> BitcoindClient [TxHash])
                                                                     :<|> (BitcoindClient
                                                                             MempoolInfo
                                                                           :<|> BitcoindClient
                                                                                  [TxHash]))))))))))))
forall x (p :: * -> *).
HasBitcoindClient x =>
p x -> TheBitcoindClient x
toBitcoindClient (Proxy BlockchainRpc
 -> BitcoindClient BlockHash
    :<|> ((BlockHash -> BitcoindClient (HexEncoded Block))
          :<|> (BitcoindClient Word32
                :<|> ((BlockHash -> BitcoindClient CompactFilter)
                      :<|> ((Word32 -> BitcoindClient BlockHash)
                            :<|> ((BlockHash -> BitcoindClient BlockHeader)
                                  :<|> ((BlockHash -> Maybe [Text] -> BitcoindClient BlockStats)
                                        :<|> (BitcoindClient [ChainTip]
                                              :<|> ((Maybe Word32
                                                     -> Maybe BlockHash
                                                     -> BitcoindClient ChainTxStats)
                                                    :<|> (BitcoindClient Scientific
                                                          :<|> ((TxHash -> BitcoindClient [TxHash])
                                                                :<|> ((TxHash
                                                                       -> BitcoindClient [TxHash])
                                                                      :<|> (BitcoindClient
                                                                              MempoolInfo
                                                                            :<|> BitcoindClient
                                                                                   [TxHash])))))))))))))
-> Proxy BlockchainRpc
-> BitcoindClient BlockHash
   :<|> ((BlockHash -> BitcoindClient (HexEncoded Block))
         :<|> (BitcoindClient Word32
               :<|> ((BlockHash -> BitcoindClient CompactFilter)
                     :<|> ((Word32 -> BitcoindClient BlockHash)
                           :<|> ((BlockHash -> BitcoindClient BlockHeader)
                                 :<|> ((BlockHash -> Maybe [Text] -> BitcoindClient BlockStats)
                                       :<|> (BitcoindClient [ChainTip]
                                             :<|> ((Maybe Word32
                                                    -> Maybe BlockHash
                                                    -> BitcoindClient ChainTxStats)
                                                   :<|> (BitcoindClient Scientific
                                                         :<|> ((TxHash -> BitcoindClient [TxHash])
                                                               :<|> ((TxHash
                                                                      -> BitcoindClient [TxHash])
                                                                     :<|> (BitcoindClient
                                                                             MempoolInfo
                                                                           :<|> BitcoindClient
                                                                                  [TxHash]))))))))))))
forall a b. (a -> b) -> a -> b
$ Proxy BlockchainRpc
forall k (t :: k). Proxy t
Proxy @BlockchainRpc

{- | 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 :: BlockHash -> BitcoindClient BlockStats
getBlockStats h :: BlockHash
h = BlockHash -> Maybe [Text] -> BitcoindClient BlockStats
getBlockStats' BlockHash
h Maybe [Text]
forall a. Maybe a
Nothing

-- | Produce the block corresponding to the given 'BlockHash' if it exists.
getBlock :: BlockHash -> BitcoindClient Block
getBlock :: BlockHash -> BitcoindClient Block
getBlock = (HexEncoded Block -> Block)
-> BitcoindClient (HexEncoded Block) -> BitcoindClient Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HexEncoded Block -> Block
forall a. HexEncoded a -> a
unHexEncoded (BitcoindClient (HexEncoded Block) -> BitcoindClient Block)
-> (BlockHash -> BitcoindClient (HexEncoded Block))
-> BlockHash
-> BitcoindClient Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> BitcoindClient (HexEncoded Block)
getBlock'