|
1 | | -{-# LANGUAGE DuplicateRecordFields, OverloadedLabels, OverloadedRecordDot #-} |
| 1 | +{-# LANGUAGE DuplicateRecordFields #-} |
| 2 | +{-# LANGUAGE OverloadedLabels #-} |
| 3 | +{-# LANGUAGE OverloadedRecordDot #-} |
| 4 | +{-# LANGUAGE ScopedTypeVariables #-} |
2 | 5 | {-# LANGUAGE TemplateHaskell #-} |
| 6 | +{-# LANGUAGE TupleSections #-} |
3 | 7 |
|
4 | 8 | module EVM.TH where |
5 | 9 |
|
6 | | -import Prelude hiding (FilePath, readFile) |
7 | | -import Data.Text (Text, pack, unpack) |
8 | | -import Data.Text.IO (readFile) |
9 | | -import Data.Map as Map |
| 10 | +import Act.Prelude (EthTransaction (..)) |
| 11 | +import Control.Monad.Trans.State.Strict (State, put) |
10 | 12 | import Data.ByteString (ByteString) |
11 | | -import Data.Vector as Vector (fromList) |
12 | | -import Data.Tree.Zipper qualified as Zipper |
13 | | - |
14 | | -import Language.Haskell.TH.Syntax as TH |
| 13 | +import Data.Map as Map |
| 14 | +import Data.Text (Text, unpack) |
| 15 | +import Data.Text.IO (readFile) |
| 16 | +import qualified Data.Tree.Zipper as Zipper |
| 17 | +import Data.Vector as Vector (fromList) |
| 18 | +import EVM (blankState, initialContract) |
15 | 19 | import EVM.ABI |
| 20 | +import EVM.FeeSchedule |
16 | 21 | import EVM.Solidity (solcRuntime) |
17 | 22 | import EVM.Types |
18 | | -import EVM.FeeSchedule |
19 | | -import EVM (blankState, initialContract) |
20 | | -import Act.Prelude (EthTransaction(..)) |
21 | | -import Control.Monad.Trans.State.Strict (State, put) |
22 | | - |
23 | 23 | import GHC.IO.Unsafe |
| 24 | +import Language.Haskell.TH.Syntax as TH |
| 25 | +import Prelude hiding (FilePath, readFile) |
24 | 26 |
|
| 27 | +-- put this in sttate.callData |
| 28 | +-- run it to execute the transaction |
| 29 | +-- put more for subsequent calls |
| 30 | +-- run more for more results |
25 | 31 | makeCallData :: EthTransaction -> ByteString |
26 | 32 | makeCallData (EthTransaction _ method args _ _) = |
27 | 33 | abiMethod method (AbiTuple (Vector.fromList args)) |
28 | 34 |
|
29 | 35 | emptyVM :: [(Addr, ByteString)] -> VM |
30 | | -emptyVM contracts = VM |
31 | | - { result = Nothing |
32 | | - , state = blankState |
33 | | - , frames = [] |
34 | | - , env = envForContracts contracts |
35 | | - , block = emptyBlock |
36 | | - , tx = emptyTransaction |
37 | | - , logs = [] |
38 | | - , traces = Zipper.fromForest mempty |
39 | | - , cache = Cache mempty mempty mempty |
40 | | - , burned = 0 |
41 | | - , iterations = mempty |
42 | | - , constraints = [] |
43 | | - , keccakEqs = [] |
44 | | - , allowFFI = True |
45 | | - , overrideCaller = Nothing |
46 | | - } |
47 | | - where |
48 | | - -- question: Is that a reasonable empty first block? |
49 | | - emptyBlock :: Block |
50 | | - emptyBlock = Block |
51 | | - { coinbase = 0 |
52 | | - , timestamp = Lit 0 |
53 | | - , number = 0 |
54 | | - , prevRandao = 0 |
55 | | - , maxCodeSize = 0 |
56 | | - , gaslimit = 0 |
57 | | - , baseFee = 0 |
58 | | - , schedule = berlin -- specifically this, what is it suppsoed to be? |
59 | | - } |
60 | | - emptyTransaction :: TxState |
61 | | - emptyTransaction = TxState |
62 | | - { gasprice = 0 |
63 | | - , gaslimit = 0 |
64 | | - , priorityFee = 0 |
65 | | - , origin = 0 |
66 | | - , toAddr = 0 |
67 | | - , value = Lit 0 |
68 | | - , substate = emptySubState |
69 | | - , isCreate = True |
70 | | - , txReversion = mempty |
71 | | - } |
72 | | - emptySubState :: SubState |
73 | | - emptySubState = SubState |
74 | | - { selfdestructs = [] |
75 | | - , touchedAccounts = [] |
76 | | - , accessedAddresses = mempty |
77 | | - , accessedStorageKeys = mempty |
78 | | - , refunds = [] |
| 36 | +emptyVM contracts = |
| 37 | + VM |
| 38 | + { result = Nothing, |
| 39 | + state = blankState, |
| 40 | + frames = [], |
| 41 | + env = envForContracts contracts, |
| 42 | + block = emptyBlock, |
| 43 | + tx = emptyTransaction, |
| 44 | + logs = [], |
| 45 | + traces = Zipper.fromForest mempty, |
| 46 | + cache = Cache mempty mempty mempty, |
| 47 | + burned = 0, |
| 48 | + iterations = mempty, |
| 49 | + constraints = [], |
| 50 | + keccakEqs = [], |
| 51 | + allowFFI = True, |
| 52 | + overrideCaller = Nothing |
79 | 53 | } |
| 54 | + where |
| 55 | + -- question: Is that a reasonable empty first block? |
| 56 | + emptyBlock :: Block |
| 57 | + emptyBlock = |
| 58 | + Block |
| 59 | + { coinbase = 0, |
| 60 | + timestamp = Lit 0, |
| 61 | + number = 0, |
| 62 | + prevRandao = 0, |
| 63 | + maxCodeSize = 0, |
| 64 | + gaslimit = 0, |
| 65 | + baseFee = 0, |
| 66 | + schedule = berlin -- specifically this, what is it suppsoed to be? |
| 67 | + } |
| 68 | + emptyTransaction :: TxState |
| 69 | + emptyTransaction = |
| 70 | + TxState |
| 71 | + { gasprice = 0, |
| 72 | + gaslimit = 0, |
| 73 | + priorityFee = 0, |
| 74 | + origin = 0, |
| 75 | + toAddr = 0, |
| 76 | + value = Lit 0, |
| 77 | + substate = emptySubState, |
| 78 | + isCreate = True, |
| 79 | + txReversion = mempty |
| 80 | + } |
| 81 | + emptySubState :: SubState |
| 82 | + emptySubState = |
| 83 | + SubState |
| 84 | + { selfdestructs = [], |
| 85 | + touchedAccounts = [], |
| 86 | + accessedAddresses = mempty, |
| 87 | + accessedStorageKeys = mempty, |
| 88 | + refunds = [] |
| 89 | + } |
80 | 90 |
|
81 | | - envForContracts :: [(Addr, ByteString)] -> Env |
82 | | - envForContracts contracts = Env |
83 | | - { contracts = Map.fromList (fmap (fmap bytecodeToContract) contracts) |
84 | | - , chainId = 0 |
85 | | - , storage = EmptyStore |
86 | | - , origStorage = mempty |
87 | | - , sha3Crack = mempty |
88 | | - } |
| 91 | + envForContracts :: [(Addr, ByteString)] -> Env |
| 92 | + envForContracts contracts = |
| 93 | + Env |
| 94 | + { contracts = Map.fromList (fmap (fmap bytecodeToContract) contracts), |
| 95 | + chainId = 0, |
| 96 | + storage = EmptyStore, |
| 97 | + origStorage = mempty, |
| 98 | + sha3Crack = mempty |
| 99 | + } |
89 | 100 |
|
90 | | - bytecodeToContract :: ByteString -> Contract |
91 | | - bytecodeToContract = initialContract . RuntimeCode . ConcreteRuntimeCode |
| 101 | + bytecodeToContract :: ByteString -> Contract |
| 102 | + bytecodeToContract = initialContract . RuntimeCode . ConcreteRuntimeCode |
92 | 103 |
|
93 | 104 | -- setup a new VM state from the list of contracts we are using |
94 | 105 | loadIntoVM :: [(Addr, ByteString)] -> State VM () |
95 | | -loadIntoVM contracts = |
96 | | - put (emptyVM contracts) |
| 106 | +loadIntoVM contracts = put (emptyVM contracts) |
97 | 107 |
|
98 | 108 | -- import a list of contracts as an open game |
99 | 109 | -- - first we read off all the files and translate them into solidity bytecode |
100 | 110 | -- - Then we associate each contract to a contract name which |
101 | 111 | loadEVM :: [(Text, Text)] -> IO (State VM ()) |
102 | 112 | loadEVM contracts = do |
103 | 113 | files :: [(Text, Text)] <- traverse (\(name, filename) -> (name,) <$> readFile (unpack filename)) (contracts) |
104 | | - contracts :: [ByteString] <- traverse (\(nm, body) -> do |
105 | | - Just bytecode <- solcRuntime nm body |
106 | | - pure bytecode) files |
107 | | - let bytecodeMap :: [(Addr, ByteString)] = zip [0 .. ] contracts |
| 114 | + contracts :: [ByteString] <- |
| 115 | + traverse |
| 116 | + ( \(nm, body) -> do |
| 117 | + Just bytecode <- solcRuntime nm body |
| 118 | + pure bytecode |
| 119 | + ) |
| 120 | + files |
| 121 | + let bytecodeMap :: [(Addr, ByteString)] = zip [0 ..] contracts |
108 | 122 | let newVM = loadIntoVM bytecodeMap |
109 | 123 | pure newVM |
110 | 124 |
|
111 | | -loadContracts :: [(Text,Text)] -> Q [Dec] |
112 | | -loadContracts arg = [d|vmState :: State VM (); vmState = $([e|unsafePerformIO $ loadEVM arg|])|] |
| 125 | +loadContracts :: [(Text, Text)] -> State VM () |
| 126 | +loadContracts arg = unsafePerformIO $ loadEVM arg |
| 127 | + |
| 128 | +compileTimeLoad :: [(Text, Text)] -> Q [Dec] |
| 129 | +compileTimeLoad = undefined |
0 commit comments