{-# 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])


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


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


-- | 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
    :<|> getBlock
    :<|> getBlockCount
    :<|> getBlockHash
    :<|> getBlockHeader
    :<|> getBlockStats'
    :<|> getChainTips
    :<|> getChainTxStats
    :<|> getDifficulty
    :<|> getMempoolAncestors
    :<|> getMempoolDescendants
    :<|> getMempoolInfo
    :<|> 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.
getBlockStats :: BlockHash -> BitcoindClient BlockStats
getBlockStats h = getBlockStats' h Nothing