-
Notifications
You must be signed in to change notification settings - Fork 58
/
Copy pathrpc.hs
168 lines (150 loc) · 6.75 KB
/
rpc.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
{-# LANGUAGE DataKinds #-}
module Main where
import Test.Tasty
import Test.Tasty.HUnit
import Data.Maybe
import Data.Map qualified as Map
import Data.Text (Text)
import Data.Vector qualified as V
import Optics.Core
import EVM (makeVm, symbolify, forceLit)
import EVM.ABI
import EVM.Fetch
import EVM.SMT
import EVM.Solvers
import EVM.Stepper qualified as Stepper
import EVM.SymExec
import EVM.Test.Utils
import EVM.Solidity (ProjectType(..))
import EVM.Types hiding (BlockNumber, Env)
import Control.Monad.ST (stToIO, RealWorld)
import Control.Monad.Reader (ReaderT)
import Control.Monad.IO.Unlift
import EVM.Effects
rpcEnv :: Env
rpcEnv = Env { config = defaultConfig }
test :: TestName -> ReaderT Env IO () -> TestTree
test a b = testCase a $ runEnv rpcEnv b
main :: IO ()
main = defaultMain tests
tests :: TestTree
tests = testGroup "rpc"
[ testGroup "Block Parsing Tests"
[ testCase "pre-merge-block" $ do
let block = BlockNumber 15537392
(cb, numb, basefee, prevRan) <- fetchBlockFrom block testRpc >>= \case
Nothing -> internalError "Could not fetch block"
Just Block{..} -> pure ( coinbase
, number
, baseFee
, prevRandao
)
assertEqual "coinbase" (LitAddr 0xea674fdde714fd979de3edf0f56aa9716b898ec8) cb
assertEqual "number" (BlockNumber (forceLit numb)) block
assertEqual "basefee" 38572377838 basefee
assertEqual "prevRan" 11049842297455506 prevRan
, testCase "post-merge-block" $ do
let block = BlockNumber 16184420
(cb, numb, basefee, prevRan) <- fetchBlockFrom block testRpc >>= \case
Nothing -> internalError "Could not fetch block"
Just Block{..} -> pure ( coinbase
, number
, baseFee
, prevRandao
)
assertEqual "coinbase" (LitAddr 0x690b9a9e9aa1c9db991c7721a92d351db4fac990) cb
assertEqual "number" (BlockNumber (forceLit numb)) block
assertEqual "basefee" 22163046690 basefee
assertEqual "prevRan" 0x2267531ab030ed32fd5f2ef51f81427332d0becbd74fe7f4cd5684ddf4b287e0 prevRan
]
, testGroup "execution with remote state"
-- execute against remote state from a ds-test harness
[ test "dapp-test" $ do
let testFile = "test/contracts/pass/rpc.sol"
res <- runSolidityTestCustom testFile ".*" Nothing Nothing False testRpcInfo Foundry
liftIO $ assertEqual "test result" (True, True) res
-- concretely exec "transfer" on WETH9 using remote rpc
-- https://etherscan.io/token/0xc02aaa39b223fe8d0a0e5c4f27ead9083c756cc2#code
, test "weth-conc" $ do
let
blockNum = 16198552
wad = 0x999999999999999999
calldata' = ConcreteBuf $ abiMethod "transfer(address,uint256)" (AbiTuple (V.fromList [AbiAddress (Addr 0xdead), AbiUInt 256 wad]))
vm <- liftIO $ weth9VM blockNum (calldata', [])
postVm <- withSolvers Z3 1 1 Nothing $ \solvers ->
Stepper.interpret (oracle solvers (Just (BlockNumber blockNum, testRpc))) vm Stepper.runFully
let
wethStore = (fromJust $ Map.lookup (LitAddr 0xC02aaA39b223FE8D0A0e5C4F27eAD9083C756Cc2) postVm.env.contracts).storage
wethStore' = case wethStore of
ConcreteStore s -> s
_ -> internalError "Expecting concrete store"
receiverBal = fromJust $ Map.lookup (keccak' (word256Bytes 0xdead <> word256Bytes 0x3)) wethStore'
msg = case postVm.result of
Just (VMSuccess m) -> m
_ -> internalError "VMSuccess expected"
liftIO $ do
assertEqual "should succeed" msg (ConcreteBuf $ word256Bytes 0x1)
assertEqual "should revert" receiverBal (W256 $ 2595433725034301 + wad)
-- symbolically exec "transfer" on WETH9 using remote rpc
-- https://etherscan.io/token/0xc02aaa39b223fe8d0a0e5c4f27ead9083c756cc2#code
, test "weth-sym" $ do
calldata' <- symCalldata "transfer(address,uint256)" [AbiAddressType, AbiUIntType 256] ["0xdead"] (AbstractBuf "txdata")
let
blockNum = 16198552
postc _ (Failure _ _ (Revert _)) = PBool False
postc _ _ = PBool True
vm <- liftIO $ weth9VM blockNum calldata'
(_, [Cex (_, model)]) <- withSolvers Z3 1 1 Nothing $ \solvers ->
verify solvers (rpcVeriOpts (BlockNumber blockNum, testRpc)) (symbolify vm) (Just postc)
liftIO $ assertBool "model should exceed caller balance" (getVar model "arg2" >= 695836005599316055372648)
]
]
-- call into WETH9 from 0xf04a... (a large holder)
weth9VM :: W256 -> (Expr Buf, [Prop]) -> IO (VM Concrete RealWorld)
weth9VM blockNum calldata' = do
let
caller' = LitAddr 0xf04a5cc80b1e94c69b48f5ee68a08cd2f09a7c3e
weth9 = Addr 0xC02aaA39b223FE8D0A0e5C4F27eAD9083C756Cc2
callvalue' = Lit 0
vmFromRpc blockNum calldata' callvalue' caller' weth9
vmFromRpc :: W256 -> (Expr Buf, [Prop]) -> Expr EWord -> Expr EAddr -> Addr -> IO (VM Concrete RealWorld)
vmFromRpc blockNum calldata callvalue caller address = do
ctrct <- fetchContractFrom (BlockNumber blockNum) testRpc address >>= \case
Nothing -> internalError $ "contract not found: " <> show address
Just contract' -> pure contract'
blk <- fetchBlockFrom (BlockNumber blockNum) testRpc >>= \case
Nothing -> internalError "could not fetch block"
Just b -> pure b
stToIO $ (makeVm $ VMOpts
{ contract = ctrct
, otherContracts = []
, calldata = calldata
, value = callvalue
, address = LitAddr address
, caller = caller
, origin = LitAddr 0xacab
, gas = 0xffffffffffffffff
, gaslimit = 0xffffffffffffffff
, baseFee = blk.baseFee
, priorityFee = 0
, coinbase = blk.coinbase
, number = blk.number
, timestamp = blk.timestamp
, blockGaslimit = blk.gaslimit
, gasprice = 0
, maxCodeSize = blk.maxCodeSize
, prevRandao = blk.prevRandao
, schedule = blk.schedule
, chainId = 1
, create = False
, baseState = EmptyBase
, txAccessList = mempty
, allowFFI = False
, freshAddresses = 0
, beaconRoot = 0
, minMemoryChunk = 1
}) <&> set (#cache % #fetched % at address) (Just ctrct)
testRpc :: Text
testRpc = "https://eth-mainnet.alchemyapi.io/v2/vpeKFsEF6PHifHzdtcwXSDbhV3ym5Ro4"
testRpcInfo :: RpcInfo
testRpcInfo = Just (BlockNumber 16198552, testRpc)