{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Network.Polkadot.Rpc.System
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Polkadot RPC methods with `system` prefix.
--

module Network.Polkadot.Rpc.System where

import           Data.Aeson                 (Object)
import           Data.Text                  (Text)
import           Network.JsonRpc.TinyClient (JsonRpc (..))

import           Network.Polkadot.Rpc.Types (ChainType, Health, NodeRole,
                                             PeerInfo)

-- | Adds a reserved peer.
addReservedPeer :: JsonRpc m
                => Text
                -- ^ Peer URI
                -> m Text
{-# INLINE addReservedPeer #-}
addReservedPeer :: forall (m :: * -> *). JsonRpc m => Text -> m Text
addReservedPeer = Text -> Text -> m Text
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_addReservedPeer"

-- | Retrieves the chain.
chain :: JsonRpc m => m Text
{-# INLINE chain #-}
chain :: forall (m :: * -> *). JsonRpc m => m Text
chain = Text -> m Text
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_chain"

-- | Retrieves the chain type.
chainType :: JsonRpc m => m ChainType
{-# INLINE chainType #-}
chainType :: forall (m :: * -> *). JsonRpc m => m ChainType
chainType = Text -> m ChainType
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_chainType"

-- | Return health status of the node.
health :: JsonRpc m => m Health
{-# INLINE health #-}
health :: forall (m :: * -> *). JsonRpc m => m Health
health = Text -> m Health
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_health"

-- | The addresses include a trailing /p2p/ with the local PeerId,
-- and are thus suitable to be passed to addReservedPeer or as a bootnode address.
localListenAddresses :: JsonRpc m => m [Text]
{-# INLINE localListenAddresses #-}
localListenAddresses :: forall (m :: * -> *). JsonRpc m => m [Text]
localListenAddresses = Text -> m [Text]
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_localListenAddresses"

-- | Returns the base58-encoded PeerId of the node.
localPeerId :: JsonRpc m => m Text
{-# INLINE localPeerId #-}
localPeerId :: forall (m :: * -> *). JsonRpc m => m Text
localPeerId = Text -> m Text
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_localPeerId"

-- | Retrieves the node name.
name :: JsonRpc m => m Text
{-# INLINE name #-}
name :: forall (m :: * -> *). JsonRpc m => m Text
name = Text -> m Text
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_name"

-- | Returns current state of the network.
--
-- Warning: This API isn't stable.
networkState :: JsonRpc m => m Object
{-# INLINE networkState #-}
networkState :: forall (m :: * -> *). JsonRpc m => m Object
networkState = Text -> m Object
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_networkState"

-- | Returns the roles the node is running as.
nodeRoles :: JsonRpc m => m [NodeRole]
{-# INLINE nodeRoles #-}
nodeRoles :: forall (m :: * -> *). JsonRpc m => m [NodeRole]
nodeRoles = Text -> m [NodeRole]
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_nodeRoles"

-- | Returns the currently connected peers.
peers :: JsonRpc m => m [PeerInfo]
{-# INLINE peers #-}
peers :: forall (m :: * -> *). JsonRpc m => m [PeerInfo]
peers = Text -> m [PeerInfo]
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_peers"

-- | Get a custom set of properties as a JSON object, defined in the chain spec.
properties :: JsonRpc m => m Object
{-# INLINE properties #-}
properties :: forall (m :: * -> *). JsonRpc m => m Object
properties = Text -> m Object
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_properties"

-- | Remove a reserved peer.
removeReservedPeer :: JsonRpc m
                   => Text
                   -- ^ Peer URI
                   -> m Text
{-# INLINE removeReservedPeer #-}
removeReservedPeer :: forall (m :: * -> *). JsonRpc m => Text -> m Text
removeReservedPeer = Text -> Text -> m Text
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_removeReservedPeer"

-- | Retrieves the version of the node.
version :: JsonRpc m => m Text
{-# INLINE version #-}
version :: forall (m :: * -> *). JsonRpc m => m Text
version = Text -> m Text
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"system_version"