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

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           ((:<|>) (..))

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"
    Remove -> "remove"
    OneTry -> "onetry"


instance ToJSON Command where
    toJSON = toJSON . commandText


data NodeAddress = NodeAddress
    { addrTime     :: UTCTime
    , addrServices :: Word64
    , addrHost     :: Text
    , addrPort     :: Word32
    } deriving (Eq, Show)


instance FromJSON NodeAddress where
    parseJSON = withObject "NodeAddress" $ \o ->
        NodeAddress
            <$> (utcTime <$> o .: "time")
            <*> o .: "services"
            <*> o .: "address"
            <*> o .: "port"


data ConnDir = Inbound | Outbound deriving (Eq, Show, Enum)


instance FromJSON ConnDir where
    parseJSON = withText "ConnDir" fromText
        where
        fromText t
            | t == "inbound"  = return Inbound
            | t == "outbound" = return Outbound
            | otherwise       = fail "Unable to decode connection direction"


data NodeInfoAddress = NodeInfoAddress
    { nodeInfoAddress :: Text
    , 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)


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)


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
    , startingHeight :: BlockHeight
    , banScore       :: Word16
    , syncedHeaders  :: Word32
    , syncedBlocks   :: Word32
    , inflight       :: [BlockHeight]
    , whitelisted    :: Bool
    , minFeeFilter   :: Word32
    -- ^ in satoshis
    } deriving (Eq, Show)


instance FromJSON PeerInfo where
    parseJSON = withObject "PeerInfo" $ \o ->
        PeerInfo
            <$> o .: "id"
            <*> o .: "addr"
            <*> o .: "addrbind"
            <*> o .: "services"
            <*> o .: "relaytxes"
            <*> (utcTime <$> o .: "lastsend")
            <*> (utcTime <$> o .: "lastrecv")
            <*> o .: "bytessent"
            <*> o .: "bytesrecv"
            <*> (utcTime <$> o .: "conntime")
            <*> (fromIntegral @Int <$> o .: "timeoffset")
            <*> o .: "pingtime"
            <*> o .: "version"
            <*> o .: "inbound"
            <*> o .: "addnode"
            <*> o .: "startingheight"
            <*> o .: "banscore"
            <*> o .: "synced_headers"
            <*> o .: "synced_blocks"
            <*> o .: "inflight"
            <*> 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 ()


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


-- | Returns the number of connections to other nodes.
getConnectionCount :: BitcoindClient Word16


-- | 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
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
    :<|> getAddedNodeInfo
    :<|> getConnectionCount
    :<|> getNetTotals
    :<|> getNodeAddresses
    :<|> getPeerInfo
    :<|> listBanned
    = toBitcoindClient $ Proxy @NetworkRpc