mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-11-05 12:47:43 +00:00
97 lines
3.6 KiB
Haskell
97 lines
3.6 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Bots.StoreService.FakeEthNode
|
|
( FakeEthNode (..),
|
|
withFakeEthNode,
|
|
revertCalls,
|
|
sentTransactions,
|
|
fakeGas,
|
|
fakeTip,
|
|
fakeBaseFee,
|
|
)
|
|
where
|
|
|
|
import Control.Concurrent.STM
|
|
import Data.Aeson ((.:), (.=))
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Types as JT
|
|
import Data.ByteArray.Encoding (Base (Base16), convertFromBase, convertToBase)
|
|
import Data.ByteString (ByteString)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
|
import Network.HTTP.Client (Manager)
|
|
import qualified Network.HTTP.Client as HTTP
|
|
import Network.HTTP.Types (badRequest400, hContentType, ok200)
|
|
import Network.Wai (Application, responseLBS, strictRequestBody)
|
|
import qualified Network.Wai.Handler.Warp as Warp
|
|
import Numeric (showHex)
|
|
import Simplex.Messaging.Crypto (keccak256)
|
|
import Simplex.Messaging.Util (eitherToMaybe)
|
|
|
|
data FakeEthNode = FakeEthNode
|
|
{ fnUrl :: String,
|
|
fnManager :: Manager,
|
|
fnState :: TVar FakeState
|
|
}
|
|
|
|
data FakeState = FakeState
|
|
{ fsRevert :: Bool,
|
|
fsSent :: [ByteString]
|
|
}
|
|
|
|
fakeGas, fakeTip, fakeBaseFee :: Num a => a
|
|
fakeGas = 200000
|
|
fakeTip = 1000000000
|
|
fakeBaseFee = 2000000000
|
|
|
|
withFakeEthNode :: (FakeEthNode -> IO a) -> IO a
|
|
withFakeEthNode action = do
|
|
fnState <- newTVarIO FakeState {fsRevert = False, fsSent = []}
|
|
fnManager <- HTTP.newManager HTTP.defaultManagerSettings
|
|
Warp.testWithApplication (pure $ fakeApp fnState) $ \port ->
|
|
action FakeEthNode {fnUrl = "http://127.0.0.1:" <> show port, fnManager, fnState}
|
|
|
|
revertCalls :: FakeEthNode -> IO ()
|
|
revertCalls FakeEthNode {fnState} = atomically $ modifyTVar' fnState $ \s -> s {fsRevert = True}
|
|
|
|
sentTransactions :: FakeEthNode -> IO [ByteString]
|
|
sentTransactions FakeEthNode {fnState} = fsSent <$> readTVarIO fnState
|
|
|
|
fakeApp :: TVar FakeState -> Application
|
|
fakeApp st req respond = do
|
|
body <- strictRequestBody req
|
|
case JT.parseMaybe request =<< J.decode body of
|
|
Just (method, params) -> do
|
|
reply <- atomically $ answer st method params
|
|
respond $ responseLBS ok200 [(hContentType, "application/json")] $ J.encode $ J.object $ ["jsonrpc" .= ("2.0" :: Text), "id" .= (1 :: Int)] <> reply
|
|
Nothing -> respond $ responseLBS badRequest400 [] "not a JSON-RPC request"
|
|
where
|
|
request = J.withObject "request" $ \o -> (,) <$> o .: "method" <*> o .: "params"
|
|
|
|
answer :: TVar FakeState -> Text -> [J.Value] -> STM [JT.Pair]
|
|
answer st method params = do
|
|
s@FakeState {fsRevert, fsSent} <- readTVar st
|
|
case (method, params) of
|
|
("eth_estimateGas", _) -> pure $ if fsRevert then reverted else result $ quantity fakeGas
|
|
("eth_getTransactionCount", _) -> pure $ result $ quantity $ toInteger $ length fsSent
|
|
("eth_maxPriorityFeePerGas", _) -> pure $ result $ quantity fakeTip
|
|
("eth_getBlockByNumber", _) -> pure $ result $ J.object ["baseFeePerGas" .= quantity fakeBaseFee]
|
|
("eth_sendRawTransaction", [J.String raw]) | Just tx <- fromHex raw -> do
|
|
writeTVar st s {fsSent = tx : fsSent}
|
|
pure $ result $ hex $ keccak256 tx
|
|
_ -> pure ["error" .= J.object ["code" .= (-32601 :: Int), "message" .= ("method not found" :: Text)]]
|
|
where
|
|
result v = ["result" .= v]
|
|
reverted = ["error" .= J.object ["code" .= (3 :: Int), "message" .= ("execution reverted" :: Text)]]
|
|
|
|
quantity :: Integer -> Text
|
|
quantity n = "0x" <> T.pack (showHex n "")
|
|
|
|
hex :: ByteString -> Text
|
|
hex bs = "0x" <> decodeLatin1 (convertToBase Base16 bs)
|
|
|
|
fromHex :: Text -> Maybe ByteString
|
|
fromHex t = T.stripPrefix "0x" t >>= eitherToMaybe . convertFromBase Base16 . encodeUtf8
|