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

-- |
-- Module      :  Network.Ethereum.Web3.Eth
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unknown
--
-- Ethereum node JSON-RPC API methods with `eth_` prefix.
--

module Network.Ethereum.Api.Eth where

import           Data.ByteArray.HexString   (HexString)
import           Data.Solidity.Prim.Address (Address)
import           Data.Text                  (Text)
import           Network.Ethereum.Api.Types (Block, BlockT, Call, Change,
                                             DefaultBlock, Filter, Quantity,
                                             SyncingState, Transaction, TxReceipt)
import           Network.JsonRpc.TinyClient (JsonRpc (..))

-- | Returns the current ethereum protocol version.
protocolVersion :: JsonRpc m => m Text
{-# INLINE protocolVersion #-}
protocolVersion :: m Text
protocolVersion = Text -> m Text
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_protocolVersion"

-- | Returns an object with data about the sync status or false.
syncing :: JsonRpc m => m SyncingState
{-# INLINE syncing #-}
syncing :: m SyncingState
syncing = Text -> m SyncingState
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_syncing"

-- | Returns the client coinbase address.
coinbase :: JsonRpc m => m Address
{-# INLINE coinbase #-}
coinbase :: m Address
coinbase = Text -> m Address
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_coinbase"

-- | Returns true if client is actively mining new blocks.
mining :: JsonRpc m => m Bool
{-# INLINE mining #-}
mining :: m Bool
mining = Text -> m Bool
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_mining"

-- | Returns the number of hashes per second that the node is mining with.
hashrate :: JsonRpc m => m Quantity
{-# INLINE hashrate #-}
hashrate :: m Quantity
hashrate = Text -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_hashrate"

-- | Returns the value from a storage position at a given address.
getStorageAt :: JsonRpc m => Address -> Quantity -> DefaultBlock -> m HexString
{-# INLINE getStorageAt #-}
getStorageAt :: Address -> Quantity -> DefaultBlock -> m HexString
getStorageAt = Text -> Address -> Quantity -> DefaultBlock -> m HexString
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getStorageAt"

-- | Returns the number of transactions sent from an address.
getTransactionCount :: JsonRpc m => Address -> DefaultBlock -> m Quantity
{-# INLINE getTransactionCount #-}
getTransactionCount :: Address -> DefaultBlock -> m Quantity
getTransactionCount = Text -> Address -> DefaultBlock -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getTransactionCount"

-- | Returns the number of transactions in a block from a block matching the given block hash.
getBlockTransactionCountByHash :: JsonRpc m => HexString -> m Quantity
{-# INLINE getBlockTransactionCountByHash #-}
getBlockTransactionCountByHash :: HexString -> m Quantity
getBlockTransactionCountByHash = Text -> HexString -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getBlockTransactionCountByHash"

-- | Returns the number of transactions in a block matching the
-- given block number.
getBlockTransactionCountByNumber :: JsonRpc m => Quantity -> m Quantity
{-# INLINE getBlockTransactionCountByNumber #-}
getBlockTransactionCountByNumber :: Quantity -> m Quantity
getBlockTransactionCountByNumber = Text -> Quantity -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getBlockTransactionCountByNumber"

-- | Returns the number of uncles in a block from a block matching the given
-- block hash.
getUncleCountByBlockHash :: JsonRpc m => HexString -> m Quantity
{-# INLINE getUncleCountByBlockHash #-}
getUncleCountByBlockHash :: HexString -> m Quantity
getUncleCountByBlockHash = Text -> HexString -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getUncleCountByBlockHash"

-- | Returns the number of uncles in a block from a block matching the given
-- block number.
getUncleCountByBlockNumber :: JsonRpc m => Quantity -> m Quantity
{-# INLINE getUncleCountByBlockNumber #-}
getUncleCountByBlockNumber :: Quantity -> m Quantity
getUncleCountByBlockNumber = Text -> Quantity -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getUncleCountByBlockNumber"

-- | Returns code at a given address.
getCode :: JsonRpc m => Address -> DefaultBlock -> m HexString
{-# INLINE getCode #-}
getCode :: Address -> DefaultBlock -> m HexString
getCode = Text -> Address -> DefaultBlock -> m HexString
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getCode"

-- | Returns an Ethereum specific signature with:
-- sign(keccak256("\x19Ethereum Signed Message:\n" + len(message) + message))).
sign :: JsonRpc m => Address -> HexString -> m HexString
{-# INLINE sign #-}
sign :: Address -> HexString -> m HexString
sign = Text -> Address -> HexString -> m HexString
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_sign"

-- | Creates new message call transaction or a contract creation,
-- if the data field contains code.
sendTransaction :: JsonRpc m => Call -> m HexString
{-# INLINE sendTransaction #-}
sendTransaction :: Call -> m HexString
sendTransaction = Text -> Call -> m HexString
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_sendTransaction"

-- | Creates new message call transaction or a contract creation for signed
-- transactions.
sendRawTransaction :: JsonRpc m => HexString -> m HexString
{-# INLINE sendRawTransaction #-}
sendRawTransaction :: HexString -> m HexString
sendRawTransaction = Text -> HexString -> m HexString
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_sendRawTransaction"

-- | Returns the balance of the account of given address.
getBalance :: JsonRpc m => Address -> DefaultBlock -> m Quantity
{-# INLINE getBalance #-}
getBalance :: Address -> DefaultBlock -> m Quantity
getBalance = Text -> Address -> DefaultBlock -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getBalance"

-- | Creates a filter object, based on filter options, to notify when the
-- state changes (logs). To check if the state has changed, call
-- 'getFilterChanges'.
newFilter :: JsonRpc m => Filter e -> m Quantity
{-# INLINE newFilter #-}
newFilter :: Filter e -> m Quantity
newFilter = Text -> Filter e -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_newFilter"

-- | Polling method for a filter, which returns an array of logs which
-- occurred since last poll.
getFilterChanges :: JsonRpc m => Quantity -> m [Change]
{-# INLINE getFilterChanges #-}
getFilterChanges :: Quantity -> m [Change]
getFilterChanges = Text -> Quantity -> m [Change]
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getFilterChanges"

-- | Uninstalls a filter with given id.
-- Should always be called when watch is no longer needed.
uninstallFilter :: JsonRpc m => Quantity -> m Bool
{-# INLINE uninstallFilter #-}
uninstallFilter :: Quantity -> m Bool
uninstallFilter = Text -> Quantity -> m Bool
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_uninstallFilter"

-- | Returns an array of all logs matching a given filter object.
getLogs :: JsonRpc m => Filter e -> m [Change]
{-# INLINE getLogs #-}
getLogs :: Filter e -> m [Change]
getLogs = Text -> Filter e -> m [Change]
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getLogs"

-- | Executes a new message call immediately without creating a
-- transaction on the block chain.
call :: JsonRpc m => Call -> DefaultBlock -> m HexString
{-# INLINE call #-}
call :: Call -> DefaultBlock -> m HexString
call = Text -> Call -> DefaultBlock -> m HexString
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_call"

-- | Makes a call or transaction, which won't be added to the blockchain and
-- returns the used gas, which can be used for estimating the used gas.
estimateGas :: JsonRpc m => Call -> m Quantity
{-# INLINE estimateGas #-}
estimateGas :: Call -> m Quantity
estimateGas = Text -> Call -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_estimateGas"

-- | Returns information about a block by hash with only hashes of the transactions in it.
getBlockByHashLite :: JsonRpc m => HexString -> m (Maybe (BlockT HexString))
{-# INLINE getBlockByHashLite #-}
getBlockByHashLite :: HexString -> m (Maybe (BlockT HexString))
getBlockByHashLite = (HexString -> Bool -> m (Maybe (BlockT HexString)))
-> Bool -> HexString -> m (Maybe (BlockT HexString))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> HexString -> Bool -> m (Maybe (BlockT HexString))
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getBlockByHash") Bool
False

-- | Returns information about a block by block number with only hashes of the transactions in it.
getBlockByNumberLite :: JsonRpc m => Quantity -> m (Maybe (BlockT HexString))
{-# INLINE getBlockByNumberLite #-}
getBlockByNumberLite :: Quantity -> m (Maybe (BlockT HexString))
getBlockByNumberLite = (Quantity -> Bool -> m (Maybe (BlockT HexString)))
-> Bool -> Quantity -> m (Maybe (BlockT HexString))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Quantity -> Bool -> m (Maybe (BlockT HexString))
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getBlockByNumber") Bool
False

-- | Returns information about a block by hash.
getBlockByHash :: JsonRpc m => HexString -> m (Maybe Block)
{-# INLINE getBlockByHash #-}
getBlockByHash :: HexString -> m (Maybe Block)
getBlockByHash = (HexString -> Bool -> m (Maybe Block))
-> Bool -> HexString -> m (Maybe Block)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> HexString -> Bool -> m (Maybe Block)
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getBlockByHash") Bool
True

-- | Returns information about a block by block number.
getBlockByNumber :: JsonRpc m => Quantity -> m (Maybe Block)
{-# INLINE getBlockByNumber #-}
getBlockByNumber :: Quantity -> m (Maybe Block)
getBlockByNumber = (Quantity -> Bool -> m (Maybe Block))
-> Bool -> Quantity -> m (Maybe Block)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Quantity -> Bool -> m (Maybe Block)
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getBlockByNumber") Bool
True

-- | Returns the information about a transaction requested by transaction hash.
getTransactionByHash :: JsonRpc m => HexString -> m (Maybe Transaction)
{-# INLINE getTransactionByHash #-}
getTransactionByHash :: HexString -> m (Maybe Transaction)
getTransactionByHash = Text -> HexString -> m (Maybe Transaction)
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getTransactionByHash"

-- | Returns information about a transaction by block hash and transaction index position.
getTransactionByBlockHashAndIndex :: JsonRpc m => HexString -> Quantity -> m (Maybe Transaction)
{-# INLINE getTransactionByBlockHashAndIndex #-}
getTransactionByBlockHashAndIndex :: HexString -> Quantity -> m (Maybe Transaction)
getTransactionByBlockHashAndIndex = Text -> HexString -> Quantity -> m (Maybe Transaction)
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getTransactionByBlockHashAndIndex"

-- | Returns information about a transaction by block number and transaction
-- index position.
getTransactionByBlockNumberAndIndex :: JsonRpc m => DefaultBlock -> Quantity -> m (Maybe Transaction)
{-# INLINE getTransactionByBlockNumberAndIndex #-}
getTransactionByBlockNumberAndIndex :: DefaultBlock -> Quantity -> m (Maybe Transaction)
getTransactionByBlockNumberAndIndex = Text -> DefaultBlock -> Quantity -> m (Maybe Transaction)
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getTransactionByBlockNumberAndIndex"

-- | Returns the receipt of a transaction by transaction hash.
getTransactionReceipt :: JsonRpc m => HexString -> m (Maybe TxReceipt)
{-# INLINE getTransactionReceipt #-}
getTransactionReceipt :: HexString -> m (Maybe TxReceipt)
getTransactionReceipt = Text -> HexString -> m (Maybe TxReceipt)
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getTransactionReceipt"

-- | Returns a list of addresses owned by client.
accounts :: JsonRpc m => m [Address]
{-# INLINE accounts #-}
accounts :: m [Address]
accounts = Text -> m [Address]
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_accounts"

-- | Creates a filter in the node, to notify when a new block arrives.
newBlockFilter :: JsonRpc m => m Quantity
{-# INLINE newBlockFilter #-}
newBlockFilter :: m Quantity
newBlockFilter = Text -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_newBlockFilter"

-- | Polling method for a block filter, which returns an array of block hashes
-- occurred since last poll.
getBlockFilterChanges :: JsonRpc m => Quantity -> m [HexString]
{-# INLINE getBlockFilterChanges #-}
getBlockFilterChanges :: Quantity -> m [HexString]
getBlockFilterChanges = Text -> Quantity -> m [HexString]
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getFilterChanges"

-- | Returns the number of most recent block.
blockNumber :: JsonRpc m => m Quantity
{-# INLINE blockNumber #-}
blockNumber :: m Quantity
blockNumber = Text -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_blockNumber"

-- | Returns the current price per gas in wei.
gasPrice :: JsonRpc m => m Quantity
{-# INLINE gasPrice #-}
gasPrice :: m Quantity
gasPrice = Text -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_gasPrice"

-- | Returns information about a uncle of a block by hash and uncle index
-- position.
getUncleByBlockHashAndIndex :: JsonRpc m => HexString -> Quantity -> m Block
{-# INLINE getUncleByBlockHashAndIndex #-}
getUncleByBlockHashAndIndex :: HexString -> Quantity -> m Block
getUncleByBlockHashAndIndex = Text -> HexString -> Quantity -> m Block
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getUncleByBlockHashAndIndex"

-- | Returns information about a uncle of a block by number and uncle index
-- position.
getUncleByBlockNumberAndIndex :: JsonRpc m => DefaultBlock -> Quantity -> m Block
{-# INLINE getUncleByBlockNumberAndIndex #-}
getUncleByBlockNumberAndIndex :: DefaultBlock -> Quantity -> m Block
getUncleByBlockNumberAndIndex = Text -> DefaultBlock -> Quantity -> m Block
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getUncleByBlockNumberAndIndex"

-- | Creates a filter in the node, to notify when new pending transactions arrive. To check if the state has changed, call getFilterChanges. Returns a FilterId.
newPendingTransactionFilter :: JsonRpc m => m Quantity
{-# INLINE newPendingTransactionFilter #-}
newPendingTransactionFilter :: m Quantity
newPendingTransactionFilter = Text -> m Quantity
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_newPendingTransactionFilter"

-- | Returns an array of all logs matching filter with given id.
getFilterLogs :: JsonRpc m => Quantity -> m [Change]
{-# INLINE getFilterLogs #-}
getFilterLogs :: Quantity -> m [Change]
getFilterLogs = Text -> Quantity -> m [Change]
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getFilterLogs"

-- | Returns the hash of the current block, the seedHash, and the boundary
-- condition to be met ("target").
getWork :: JsonRpc m => m [HexString]
{-# INLINE getWork #-}
getWork :: m [HexString]
getWork = Text -> m [HexString]
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_getWork"

-- | Used for submitting a proof-of-work solution.
-- Parameters:
-- 1. DATA, 8 Bytes - The nonce found (64 bits)
-- 2. DATA, 32 Bytes - The header's pow-hash (256 bits)
-- 3. DATA, 32 Bytes - The mix digest (256 bits)
submitWork :: JsonRpc m => HexString -> HexString -> HexString -> m Bool
{-# INLINE submitWork #-}
submitWork :: HexString -> HexString -> HexString -> m Bool
submitWork = Text -> HexString -> HexString -> HexString -> m Bool
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_submitWork"

-- | Used for submitting mining hashrate.
-- Parameters:
-- 1. Hashrate, a hexadecimal string representation (32 bytes) of the hash rate
-- 2. ID, String - A random hexadecimal(32 bytes) ID identifying the client
submitHashrate :: JsonRpc m => HexString -> HexString -> m Bool
{-# INLINE submitHashrate #-}
submitHashrate :: HexString -> HexString -> m Bool
submitHashrate = Text -> HexString -> HexString -> m Bool
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"eth_submitHashrate"