{-# 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 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 (Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, Int -> Command
Command -> Int
Command -> [Command]
Command -> Command
Command -> Command -> [Command]
Command -> Command -> Command -> [Command]
(Command -> Command)
-> (Command -> Command)
-> (Int -> Command)
-> (Command -> Int)
-> (Command -> [Command])
-> (Command -> Command -> [Command])
-> (Command -> Command -> [Command])
-> (Command -> Command -> Command -> [Command])
-> Enum Command
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Command -> Command -> Command -> [Command]
$cenumFromThenTo :: Command -> Command -> Command -> [Command]
enumFromTo :: Command -> Command -> [Command]
$cenumFromTo :: Command -> Command -> [Command]
enumFromThen :: Command -> Command -> [Command]
$cenumFromThen :: Command -> Command -> [Command]
enumFrom :: Command -> [Command]
$cenumFrom :: Command -> [Command]
fromEnum :: Command -> Int
$cfromEnum :: Command -> Int
toEnum :: Int -> Command
$ctoEnum :: Int -> Command
pred :: Command -> Command
$cpred :: Command -> Command
succ :: Command -> Command
$csucc :: Command -> Command
Enum)

commandText :: Command -> Text
commandText :: Command -> Text
commandText = \case
    Add -> "add"
    Remove -> "remove"
    OneTry -> "onetry"

instance ToJSON Command where
    toJSON :: Command -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Command -> Text) -> Command -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Text
commandText

data NodeAddress = NodeAddress
    { NodeAddress -> UTCTime
addrTime :: UTCTime
    , NodeAddress -> Word64
addrServices :: Word64
    , NodeAddress -> Text
addrHost :: Text
    , NodeAddress -> Word32
addrPort :: Word32
    }
    deriving (NodeAddress -> NodeAddress -> Bool
(NodeAddress -> NodeAddress -> Bool)
-> (NodeAddress -> NodeAddress -> Bool) -> Eq NodeAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeAddress -> NodeAddress -> Bool
$c/= :: NodeAddress -> NodeAddress -> Bool
== :: NodeAddress -> NodeAddress -> Bool
$c== :: NodeAddress -> NodeAddress -> Bool
Eq, Int -> NodeAddress -> ShowS
[NodeAddress] -> ShowS
NodeAddress -> String
(Int -> NodeAddress -> ShowS)
-> (NodeAddress -> String)
-> ([NodeAddress] -> ShowS)
-> Show NodeAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeAddress] -> ShowS
$cshowList :: [NodeAddress] -> ShowS
show :: NodeAddress -> String
$cshow :: NodeAddress -> String
showsPrec :: Int -> NodeAddress -> ShowS
$cshowsPrec :: Int -> NodeAddress -> ShowS
Show)

instance FromJSON NodeAddress where
    parseJSON :: Value -> Parser NodeAddress
parseJSON = String
-> (Object -> Parser NodeAddress) -> Value -> Parser NodeAddress
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "NodeAddress" ((Object -> Parser NodeAddress) -> Value -> Parser NodeAddress)
-> (Object -> Parser NodeAddress) -> Value -> Parser NodeAddress
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        UTCTime -> Word64 -> Text -> Word32 -> NodeAddress
NodeAddress
            (UTCTime -> Word64 -> Text -> Word32 -> NodeAddress)
-> Parser UTCTime
-> Parser (Word64 -> Text -> Word32 -> NodeAddress)
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 (Word64 -> Text -> Word32 -> NodeAddress)
-> Parser Word64 -> Parser (Text -> Word32 -> NodeAddress)
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
.: "services"
            Parser (Text -> Word32 -> NodeAddress)
-> Parser Text -> Parser (Word32 -> NodeAddress)
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
.: "address"
            Parser (Word32 -> NodeAddress)
-> Parser Word32 -> Parser NodeAddress
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
.: "port"

data ConnDir = Inbound | Outbound deriving (ConnDir -> ConnDir -> Bool
(ConnDir -> ConnDir -> Bool)
-> (ConnDir -> ConnDir -> Bool) -> Eq ConnDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnDir -> ConnDir -> Bool
$c/= :: ConnDir -> ConnDir -> Bool
== :: ConnDir -> ConnDir -> Bool
$c== :: ConnDir -> ConnDir -> Bool
Eq, Int -> ConnDir -> ShowS
[ConnDir] -> ShowS
ConnDir -> String
(Int -> ConnDir -> ShowS)
-> (ConnDir -> String) -> ([ConnDir] -> ShowS) -> Show ConnDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnDir] -> ShowS
$cshowList :: [ConnDir] -> ShowS
show :: ConnDir -> String
$cshow :: ConnDir -> String
showsPrec :: Int -> ConnDir -> ShowS
$cshowsPrec :: Int -> ConnDir -> ShowS
Show, Int -> ConnDir
ConnDir -> Int
ConnDir -> [ConnDir]
ConnDir -> ConnDir
ConnDir -> ConnDir -> [ConnDir]
ConnDir -> ConnDir -> ConnDir -> [ConnDir]
(ConnDir -> ConnDir)
-> (ConnDir -> ConnDir)
-> (Int -> ConnDir)
-> (ConnDir -> Int)
-> (ConnDir -> [ConnDir])
-> (ConnDir -> ConnDir -> [ConnDir])
-> (ConnDir -> ConnDir -> [ConnDir])
-> (ConnDir -> ConnDir -> ConnDir -> [ConnDir])
-> Enum ConnDir
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ConnDir -> ConnDir -> ConnDir -> [ConnDir]
$cenumFromThenTo :: ConnDir -> ConnDir -> ConnDir -> [ConnDir]
enumFromTo :: ConnDir -> ConnDir -> [ConnDir]
$cenumFromTo :: ConnDir -> ConnDir -> [ConnDir]
enumFromThen :: ConnDir -> ConnDir -> [ConnDir]
$cenumFromThen :: ConnDir -> ConnDir -> [ConnDir]
enumFrom :: ConnDir -> [ConnDir]
$cenumFrom :: ConnDir -> [ConnDir]
fromEnum :: ConnDir -> Int
$cfromEnum :: ConnDir -> Int
toEnum :: Int -> ConnDir
$ctoEnum :: Int -> ConnDir
pred :: ConnDir -> ConnDir
$cpred :: ConnDir -> ConnDir
succ :: ConnDir -> ConnDir
$csucc :: ConnDir -> ConnDir
Enum)

instance FromJSON ConnDir where
    parseJSON :: Value -> Parser ConnDir
parseJSON = String -> (Text -> Parser ConnDir) -> Value -> Parser ConnDir
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "ConnDir" Text -> Parser ConnDir
forall a (m :: * -> *).
(Eq a, IsString a, MonadFail m) =>
a -> m ConnDir
fromText
      where
        fromText :: a -> m ConnDir
fromText t :: a
t
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "inbound" = ConnDir -> m ConnDir
forall (m :: * -> *) a. Monad m => a -> m a
return ConnDir
Inbound
            | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "outbound" = ConnDir -> m ConnDir
forall (m :: * -> *) a. Monad m => a -> m a
return ConnDir
Outbound
            | Bool
otherwise = String -> m ConnDir
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unable to decode connection direction"

data NodeInfoAddress = NodeInfoAddress
    { NodeInfoAddress -> Text
nodeInfoAddress :: Text
    , NodeInfoAddress -> ConnDir
connDirection :: ConnDir
    }
    deriving (NodeInfoAddress -> NodeInfoAddress -> Bool
(NodeInfoAddress -> NodeInfoAddress -> Bool)
-> (NodeInfoAddress -> NodeInfoAddress -> Bool)
-> Eq NodeInfoAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeInfoAddress -> NodeInfoAddress -> Bool
$c/= :: NodeInfoAddress -> NodeInfoAddress -> Bool
== :: NodeInfoAddress -> NodeInfoAddress -> Bool
$c== :: NodeInfoAddress -> NodeInfoAddress -> Bool
Eq, Int -> NodeInfoAddress -> ShowS
[NodeInfoAddress] -> ShowS
NodeInfoAddress -> String
(Int -> NodeInfoAddress -> ShowS)
-> (NodeInfoAddress -> String)
-> ([NodeInfoAddress] -> ShowS)
-> Show NodeInfoAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeInfoAddress] -> ShowS
$cshowList :: [NodeInfoAddress] -> ShowS
show :: NodeInfoAddress -> String
$cshow :: NodeInfoAddress -> String
showsPrec :: Int -> NodeInfoAddress -> ShowS
$cshowsPrec :: Int -> NodeInfoAddress -> ShowS
Show)

instance FromJSON NodeInfoAddress where
    parseJSON :: Value -> Parser NodeInfoAddress
parseJSON = String
-> (Object -> Parser NodeInfoAddress)
-> Value
-> Parser NodeInfoAddress
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "NodeInfoAddress" ((Object -> Parser NodeInfoAddress)
 -> Value -> Parser NodeInfoAddress)
-> (Object -> Parser NodeInfoAddress)
-> Value
-> Parser NodeInfoAddress
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Text -> ConnDir -> NodeInfoAddress
NodeInfoAddress (Text -> ConnDir -> NodeInfoAddress)
-> Parser Text -> Parser (ConnDir -> NodeInfoAddress)
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
.: "address" Parser (ConnDir -> NodeInfoAddress)
-> Parser ConnDir -> Parser NodeInfoAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser ConnDir
forall a. FromJSON a => Object -> Text -> Parser a
.: "connected"

data NodeInfo = NodeInfo
    { NodeInfo -> Text
addedNode :: Text
    , NodeInfo -> Bool
connected :: Bool
    , NodeInfo -> [NodeInfoAddress]
addresses :: [NodeInfoAddress]
    }
    deriving (NodeInfo -> NodeInfo -> Bool
(NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool) -> Eq NodeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeInfo -> NodeInfo -> Bool
$c/= :: NodeInfo -> NodeInfo -> Bool
== :: NodeInfo -> NodeInfo -> Bool
$c== :: NodeInfo -> NodeInfo -> Bool
Eq, Int -> NodeInfo -> ShowS
[NodeInfo] -> ShowS
NodeInfo -> String
(Int -> NodeInfo -> ShowS)
-> (NodeInfo -> String) -> ([NodeInfo] -> ShowS) -> Show NodeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeInfo] -> ShowS
$cshowList :: [NodeInfo] -> ShowS
show :: NodeInfo -> String
$cshow :: NodeInfo -> String
showsPrec :: Int -> NodeInfo -> ShowS
$cshowsPrec :: Int -> NodeInfo -> ShowS
Show)

instance FromJSON NodeInfo where
    parseJSON :: Value -> Parser NodeInfo
parseJSON = String -> (Object -> Parser NodeInfo) -> Value -> Parser NodeInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "NodeInfo" ((Object -> Parser NodeInfo) -> Value -> Parser NodeInfo)
-> (Object -> Parser NodeInfo) -> Value -> Parser NodeInfo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Text -> Bool -> [NodeInfoAddress] -> NodeInfo
NodeInfo (Text -> Bool -> [NodeInfoAddress] -> NodeInfo)
-> Parser Text -> Parser (Bool -> [NodeInfoAddress] -> NodeInfo)
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
.: "addednode" Parser (Bool -> [NodeInfoAddress] -> NodeInfo)
-> Parser Bool -> Parser ([NodeInfoAddress] -> NodeInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "connected" Parser ([NodeInfoAddress] -> NodeInfo)
-> Parser [NodeInfoAddress] -> Parser NodeInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [NodeInfoAddress]
forall a. FromJSON a => Object -> Text -> Parser a
.: "addresses"

data NetTotals = NetTotals
    { NetTotals -> Word64
bytesReceived :: Word64
    , NetTotals -> Word64
bytesSent :: Word64
    }
    deriving (NetTotals -> NetTotals -> Bool
(NetTotals -> NetTotals -> Bool)
-> (NetTotals -> NetTotals -> Bool) -> Eq NetTotals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetTotals -> NetTotals -> Bool
$c/= :: NetTotals -> NetTotals -> Bool
== :: NetTotals -> NetTotals -> Bool
$c== :: NetTotals -> NetTotals -> Bool
Eq, Int -> NetTotals -> ShowS
[NetTotals] -> ShowS
NetTotals -> String
(Int -> NetTotals -> ShowS)
-> (NetTotals -> String)
-> ([NetTotals] -> ShowS)
-> Show NetTotals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetTotals] -> ShowS
$cshowList :: [NetTotals] -> ShowS
show :: NetTotals -> String
$cshow :: NetTotals -> String
showsPrec :: Int -> NetTotals -> ShowS
$cshowsPrec :: Int -> NetTotals -> ShowS
Show)

instance FromJSON NetTotals where
    parseJSON :: Value -> Parser NetTotals
parseJSON = String -> (Object -> Parser NetTotals) -> Value -> Parser NetTotals
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "NetTotals" ((Object -> Parser NetTotals) -> Value -> Parser NetTotals)
-> (Object -> Parser NetTotals) -> Value -> Parser NetTotals
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Word64 -> Word64 -> NetTotals
NetTotals (Word64 -> Word64 -> NetTotals)
-> Parser Word64 -> Parser (Word64 -> NetTotals)
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
.: "totalbytesrecv" Parser (Word64 -> NetTotals) -> Parser Word64 -> Parser NetTotals
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
.: "totalbytessent"

data PeerInfo = PeerInfo
    { PeerInfo -> Word16
peerIndex :: Word16
    , PeerInfo -> Text
peerAddr :: Text
    , PeerInfo -> Text
peerBind :: Text
    , PeerInfo -> Text
services :: Text
    , PeerInfo -> Bool
relay :: Bool
    , PeerInfo -> UTCTime
lastSend :: UTCTime
    , PeerInfo -> UTCTime
lastRecv :: UTCTime
    , PeerInfo -> Word64
peerBytesSent :: Word64
    , PeerInfo -> Word64
peerBytesRecv :: Word64
    , PeerInfo -> UTCTime
connTime :: UTCTime
    , PeerInfo -> NominalDiffTime
timeOffset :: NominalDiffTime
    , PeerInfo -> Maybe Double
pingTime :: Maybe Double
    , PeerInfo -> Word64
version :: Word64
    , PeerInfo -> Bool
inbound :: Bool
    , PeerInfo -> Bool
addnode :: Bool
    , PeerInfo -> Word32
startingHeight :: BlockHeight
    , PeerInfo -> Word16
banScore :: Word16
    , PeerInfo -> Word32
syncedHeaders :: Word32
    , PeerInfo -> Word32
syncedBlocks :: Word32
    , PeerInfo -> [Word32]
inflight :: [BlockHeight]
    , PeerInfo -> Bool
whitelisted :: Bool
    , -- | in satoshis
      PeerInfo -> Word32
minFeeFilter :: Word32
    }
    deriving (PeerInfo -> PeerInfo -> Bool
(PeerInfo -> PeerInfo -> Bool)
-> (PeerInfo -> PeerInfo -> Bool) -> Eq PeerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PeerInfo -> PeerInfo -> Bool
$c/= :: PeerInfo -> PeerInfo -> Bool
== :: PeerInfo -> PeerInfo -> Bool
$c== :: PeerInfo -> PeerInfo -> Bool
Eq, Int -> PeerInfo -> ShowS
[PeerInfo] -> ShowS
PeerInfo -> String
(Int -> PeerInfo -> ShowS)
-> (PeerInfo -> String) -> ([PeerInfo] -> ShowS) -> Show PeerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PeerInfo] -> ShowS
$cshowList :: [PeerInfo] -> ShowS
show :: PeerInfo -> String
$cshow :: PeerInfo -> String
showsPrec :: Int -> PeerInfo -> ShowS
$cshowsPrec :: Int -> PeerInfo -> ShowS
Show)

instance FromJSON PeerInfo where
    parseJSON :: Value -> Parser PeerInfo
parseJSON = String -> (Object -> Parser PeerInfo) -> Value -> Parser PeerInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "PeerInfo" ((Object -> Parser PeerInfo) -> Value -> Parser PeerInfo)
-> (Object -> Parser PeerInfo) -> Value -> Parser PeerInfo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
        Word16
-> Text
-> Text
-> Text
-> Bool
-> UTCTime
-> UTCTime
-> Word64
-> Word64
-> UTCTime
-> NominalDiffTime
-> Maybe Double
-> Word64
-> Bool
-> Bool
-> Word32
-> Word16
-> Word32
-> Word32
-> [Word32]
-> Bool
-> Word32
-> PeerInfo
PeerInfo
            (Word16
 -> Text
 -> Text
 -> Text
 -> Bool
 -> UTCTime
 -> UTCTime
 -> Word64
 -> Word64
 -> UTCTime
 -> NominalDiffTime
 -> Maybe Double
 -> Word64
 -> Bool
 -> Bool
 -> Word32
 -> Word16
 -> Word32
 -> Word32
 -> [Word32]
 -> Bool
 -> Word32
 -> PeerInfo)
-> Parser Word16
-> Parser
     (Text
      -> Text
      -> Text
      -> Bool
      -> UTCTime
      -> UTCTime
      -> Word64
      -> Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Word16
forall a. FromJSON a => Object -> Text -> Parser a
.: "id"
            Parser
  (Text
   -> Text
   -> Text
   -> Bool
   -> UTCTime
   -> UTCTime
   -> Word64
   -> Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Bool
      -> UTCTime
      -> UTCTime
      -> Word64
      -> Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "addr"
            Parser
  (Text
   -> Text
   -> Bool
   -> UTCTime
   -> UTCTime
   -> Word64
   -> Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> UTCTime
      -> UTCTime
      -> Word64
      -> Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "addrbind"
            Parser
  (Text
   -> Bool
   -> UTCTime
   -> UTCTime
   -> Word64
   -> Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Text
-> Parser
     (Bool
      -> UTCTime
      -> UTCTime
      -> Word64
      -> Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "services"
            Parser
  (Bool
   -> UTCTime
   -> UTCTime
   -> Word64
   -> Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Bool
-> Parser
     (UTCTime
      -> UTCTime
      -> Word64
      -> Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "relaytxes"
            Parser
  (UTCTime
   -> UTCTime
   -> Word64
   -> Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser UTCTime
-> Parser
     (UTCTime
      -> Word64
      -> Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "lastsend")
            Parser
  (UTCTime
   -> Word64
   -> Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser UTCTime
-> Parser
     (Word64
      -> Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "lastrecv")
            Parser
  (Word64
   -> Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Word64
-> Parser
     (Word64
      -> UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "bytessent"
            Parser
  (Word64
   -> UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Word64
-> Parser
     (UTCTime
      -> NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "bytesrecv"
            Parser
  (UTCTime
   -> NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser UTCTime
-> Parser
     (NominalDiffTime
      -> Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "conntime")
            Parser
  (NominalDiffTime
   -> Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser NominalDiffTime
-> Parser
     (Maybe Double
      -> Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall b. (Integral Int, Num b) => Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (Int -> NominalDiffTime) -> Parser Int -> Parser NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "timeoffset")
            Parser
  (Maybe Double
   -> Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser (Maybe Double)
-> Parser
     (Word64
      -> Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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 a
.: "pingtime"
            Parser
  (Word64
   -> Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Word64
-> Parser
     (Bool
      -> Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
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
.: "version"
            Parser
  (Bool
   -> Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Bool
-> Parser
     (Bool
      -> Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "inbound"
            Parser
  (Bool
   -> Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Bool
-> Parser
     (Word32
      -> Word16
      -> Word32
      -> Word32
      -> [Word32]
      -> Bool
      -> Word32
      -> PeerInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "addnode"
            Parser
  (Word32
   -> Word16
   -> Word32
   -> Word32
   -> [Word32]
   -> Bool
   -> Word32
   -> PeerInfo)
-> Parser Word32
-> Parser
     (Word16
      -> Word32 -> Word32 -> [Word32] -> Bool -> Word32 -> PeerInfo)
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
.: "startingheight"
            Parser
  (Word16
   -> Word32 -> Word32 -> [Word32] -> Bool -> Word32 -> PeerInfo)
-> Parser Word16
-> Parser
     (Word32 -> Word32 -> [Word32] -> Bool -> Word32 -> PeerInfo)
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
.: "banscore"
            Parser (Word32 -> Word32 -> [Word32] -> Bool -> Word32 -> PeerInfo)
-> Parser Word32
-> Parser (Word32 -> [Word32] -> Bool -> Word32 -> PeerInfo)
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
.: "synced_headers"
            Parser (Word32 -> [Word32] -> Bool -> Word32 -> PeerInfo)
-> Parser Word32 -> Parser ([Word32] -> Bool -> Word32 -> PeerInfo)
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
.: "synced_blocks"
            Parser ([Word32] -> Bool -> Word32 -> PeerInfo)
-> Parser [Word32] -> Parser (Bool -> Word32 -> PeerInfo)
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
.: "inflight"
            Parser (Bool -> Word32 -> PeerInfo)
-> Parser Bool -> Parser (Word32 -> PeerInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "whitelisted"
            Parser (Word32 -> PeerInfo) -> Parser Word32 -> Parser PeerInfo
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
.: "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 ::
    -- | node address @host:port@
    Text ->
    Command ->
    BitcoindClient ()

-- | Clear all banned IPs.
clearBanned :: BitcoindClient ()

-- | Immediately disconnects from the specified peer node.
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.
-}
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 :: Text -> Command -> BitcoindClient ()
addNode
    :<|> clearBanned :: BitcoindClient ()
clearBanned
    :<|> disconnectNode :: Text -> BitcoindClient ()
disconnectNode
    :<|> getAddedNodeInfo :: Maybe Text -> BitcoindClient [NodeInfo]
getAddedNodeInfo
    :<|> getConnectionCount :: BitcoindClient Word16
getConnectionCount
    :<|> getNetTotals :: BitcoindClient NetTotals
getNetTotals
    :<|> getNodeAddresses :: Maybe Word32 -> BitcoindClient [NodeAddress]
getNodeAddresses
    :<|> getPeerInfo :: BitcoindClient [PeerInfo]
getPeerInfo
    :<|> listBanned :: BitcoindClient [Text]
listBanned =
        Proxy NetworkRpc
-> (Text -> Command -> BitcoindClient ())
   :<|> (BitcoindClient ()
         :<|> ((Text -> BitcoindClient ())
               :<|> ((Maybe Text -> BitcoindClient [NodeInfo])
                     :<|> (BitcoindClient Word16
                           :<|> (BitcoindClient NetTotals
                                 :<|> ((Maybe Word32 -> BitcoindClient [NodeAddress])
                                       :<|> (BitcoindClient [PeerInfo]
                                             :<|> BitcoindClient [Text])))))))
forall x (p :: * -> *).
HasBitcoindClient x =>
p x -> TheBitcoindClient x
toBitcoindClient (Proxy NetworkRpc
 -> (Text -> Command -> BitcoindClient ())
    :<|> (BitcoindClient ()
          :<|> ((Text -> BitcoindClient ())
                :<|> ((Maybe Text -> BitcoindClient [NodeInfo])
                      :<|> (BitcoindClient Word16
                            :<|> (BitcoindClient NetTotals
                                  :<|> ((Maybe Word32 -> BitcoindClient [NodeAddress])
                                        :<|> (BitcoindClient [PeerInfo]
                                              :<|> BitcoindClient [Text]))))))))
-> Proxy NetworkRpc
-> (Text -> Command -> BitcoindClient ())
   :<|> (BitcoindClient ()
         :<|> ((Text -> BitcoindClient ())
               :<|> ((Maybe Text -> BitcoindClient [NodeInfo])
                     :<|> (BitcoindClient Word16
                           :<|> (BitcoindClient NetTotals
                                 :<|> ((Maybe Word32 -> BitcoindClient [NodeAddress])
                                       :<|> (BitcoindClient [PeerInfo]
                                             :<|> BitcoindClient [Text])))))))
forall a b. (a -> b) -> a -> b
$ Proxy NetworkRpc
forall k (t :: k). Proxy t
Proxy @NetworkRpc