module Ethereum.Jsonrpc.Client
( web3ClientVersion
, ethBlockNumber
, ethGetTransactionsByBlockNumber
, ethGetContractAddrByTxHash
, ethGetCode
, getCode
) where
import Blockchain.Data.Code as BDC
import Conduit
import Control.Monad.Catch
import Data.Aeson
import Data.Aeson.Types hiding (Error)
import Data.Foldable as DF
import Data.HashMap.Strict as DHS
import Data.HexString
import Data.Text as T
import Network.HTTP.Conduit as NHC hiding (port)
import Network.JsonRpc as NJ
import qualified Data.ByteString.Char8 as DBC
import qualified Data.Vector as V
data Req
= Web3_clientVersionReq
| Eth_blockNumberReq
| Eth_getBlockByNumberReq Text
Bool
| Eth_getTransactionReceiptReq Text
| Eth_getCodeReq Text
Text
deriving (Show, Eq)
parseJSONElemAtIndex
:: FromJSON a
=> Int -> V.Vector Value -> Parser a
parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx)
instance FromRequest Req where
parseParams "web3_clientVersion" = Just $ const $ return Web3_clientVersionReq
parseParams "eth_blockNumber" = Just $ const $ return Eth_blockNumberReq
parseParams "eth_getBlockByNumber" =
Just $
withArray "(blockNumber, returnFullTransation)" $
\ab ->
let n = V.length ab
in if n == 2
then do
bn <- parseJSONElemAtIndex 0 ab
full <- parseJSONElemAtIndex 1 ab
return $ Eth_getBlockByNumberReq bn full
else fail $
"cannot unpack array of length " ++
show n ++ " into a Eth_getBlockByNumberReq"
parseParams "eth_getTransactionReceipt" =
Just $
withArray "(txHash)" $
\ab ->
let n = V.length ab
in if n == 1
then do
txhash <- parseJSONElemAtIndex 0 ab
return $ Eth_getTransactionReceiptReq txhash
else fail $
"cannot unpack array of length " ++
show n ++ " into a Eth_getTransactionReceiptReq"
parseParams "eth_getCode" =
Just $
withArray "(address, blockNum)" $
\ab ->
let n = V.length ab
in if n == 2
then do
addr <- parseJSONElemAtIndex 0 ab
blk <- parseJSONElemAtIndex 1 ab
return $ Eth_getCodeReq addr blk
else fail $
"cannot unpack array of length " ++
show n ++ " into a Eth_getCodeReq"
parseParams _ = Nothing
instance ToRequest Req where
requestMethod Web3_clientVersionReq = "web3_clientVersion"
requestMethod Eth_blockNumberReq = "eth_blockNumber"
requestMethod (Eth_getBlockByNumberReq _ _) = "eth_getBlockByNumber"
requestMethod (Eth_getTransactionReceiptReq _) = "eth_getTransactionReceipt"
requestMethod (Eth_getCodeReq _ _) = "eth_getCode"
requestIsNotif = const False
instance ToJSON Req where
toJSON Web3_clientVersionReq = emptyArray
toJSON Eth_blockNumberReq = emptyArray
toJSON (Eth_getBlockByNumberReq blk full) = toJSON (blk, full)
toJSON (Eth_getTransactionReceiptReq txhash) = toJSON [txhash]
toJSON (Eth_getCodeReq addr blk) = toJSON (addr, blk)
data Res
= Web3_clientVersionRes { clientVersion :: Text}
| Eth_blockNumberRes { blockNumber :: Text}
| Eth_getBlockByNumberRes { blockInfo :: Object}
| Eth_getTransactionReceiptRes { txReceipt :: Object}
| Eth_getCodeRes { code :: Text}
deriving (Show, Eq)
instance FromResponse Res where
parseResult "web3_clientVersion" =
Just $ withText "clientVersion" (return . Web3_clientVersionRes)
parseResult "eth_blockNumber" =
Just $ withText "blockNumber" (return . Eth_blockNumberRes)
parseResult "eth_getBlockByNumber" =
Just $ withObject "result" (return . Eth_getBlockByNumberRes)
parseResult "eth_getTransactionReceipt" =
Just $ withObject "result" (return . Eth_getTransactionReceiptRes)
parseResult "eth_getCode" = Just $ withText "code" (return . Eth_getCodeRes)
parseResult _ = Nothing
instance ToJSON Res where
toJSON (Web3_clientVersionRes result) = toJSON result
toJSON (Eth_blockNumberRes result) = toJSON result
toJSON (Eth_getBlockByNumberRes result) = toJSON result
toJSON (Eth_getTransactionReceiptRes result) = toJSON result
toJSON (Eth_getCodeRes codeRes) = toJSON codeRes
callJsonRpc
:: (MonadIO m, MonadCatch m)
=> String -> Int -> Req -> m Res
callJsonRpc server port req = do
initReq <- NHC.parseUrl ("http://" ++ server ++ ":" ++ (show port))
let requ =
initReq
{ NHC.method = "POST"
, NHC.requestHeaders =
("Content-Type", "application/json") : NHC.requestHeaders initReq
, NHC.requestBody =
RequestBodyLBS $ encode $ toJSON (NJ.buildRequest V2 req (IdInt 1))
}
manager <- liftIO $ newManager tlsManagerSettings
resp <- NHC.httpLbs requ manager
case decode $ responseBody resp of
Just body ->
case fromResponse (requestMethod req) body of
Just res -> return res
Nothing -> error $ "couldn't parse json-rpc response: " ++ (show resp)
Nothing -> error $ "couldn't parse json: " ++ (show resp)
web3ClientVersion
:: (MonadIO m, MonadCatch m)
=> String -> Int -> m Text
web3ClientVersion server port = clientVersion <$> callJsonRpc server port Web3_clientVersionReq
ethBlockNumber
:: (MonadIO m, MonadCatch m)
=> String -> Int -> m Text
ethBlockNumber server port = blockNumber <$> callJsonRpc server port Eth_blockNumberReq
ethGetTransactionsByBlockNumber
:: (MonadIO m, MonadCatch m)
=> String -> Int -> Text -> m [Text]
ethGetTransactionsByBlockNumber server port blk =
(Prelude.map $ \(String s) -> s) <$> (\(Array a) -> DF.toList $ a) <$>
(lookupDefault (Array $ V.singleton (String "error")) "transactions") <$>
blockInfo <$>
callJsonRpc server port (Eth_getBlockByNumberReq blk False)
ethGetContractAddrByTxHash
:: (MonadIO m, MonadCatch m)
=> String -> Int -> Text -> m (Maybe Text)
ethGetContractAddrByTxHash server port txhash =
(\ares ->
case ares of
(String a) ->
if toLower a == "null"
then Nothing
else Just a
Null -> Nothing
other -> error $ show other) <$>
(lookupDefault (String "error") "contractAddress") <$>
txReceipt <$>
callJsonRpc server port (Eth_getTransactionReceiptReq txhash)
ethGetCode
:: (MonadIO m, MonadCatch m)
=> String -> Int -> Text -> m Text
ethGetCode server port address =
fmap code $ callJsonRpc server port (Eth_getCodeReq address "latest")
getCode
:: (MonadIO m, MonadCatch m)
=> String -> Int -> Text -> m Code
getCode server port address = do
textCode <- ethGetCode server port address
return $
BDC.Code $ toBytes (hexString (DBC.pack $ T.unpack $ T.drop 3 textCode))