diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,43 @@ # hevm changelog +## 0.46.0 - 2021-04-29 + +### Added + +- Updated to Berlin! Conformant with GeneralStateTests at commit hash `644967e345bbc6642fab613e1b1737abbe131f78`. + +### Fixed + +- ADDMOD and MULMOD by zero yields zero. +- Address calculation for newly created contracts. +- Accomodated for the notorious "anomolies on the main network" (see yellow paper Appendix K for trivia) +- A hevm crash when debugging a SELFDESTRUCT contract. + +## 0.45.0 - 2021-03-22 + +### Added + +- Two new cheatcodes were added: `sign(uint sk, bytes message)` and `addr(uint sk)`. Taken together + these should allow for much more ergonomic testing of code that handles signed messages. +- Symbolic execution can deal with partially symbolic bytecode, allowing for symbolic constructor arguments to be given in tests. + +### Fixed + +- Fixed a bug in the abiencoding. +- Fixed the range being generated by ints. +- `hevm flatten` combines the SPDX license identifiers of all source files. + +### Changed + +- updated `nixpkgs` to the `20.09` channel +- Arbitrary instance of AbiType can no longer generate a tuple + ## 0.44.1 - 2020-02-02 ### Changed - hevm cheatcodes now accept symbolic arguments, allowing e.g. symbolic jumps in time in unit tests +- More efficient arithmetic overflow checks by translating queries to a more [intelligent form](www.microsoft.com/en-us/research/wp-content/uploads/2016/02/z3prefix.pdf). ## 0.44.0 - 2020-01-26 @@ -14,7 +47,6 @@ well as `--combined-json`. - addresses in the trace output are prefixed with `ContractName@0x...` if there is a corresponding contract and `@0x...` otherwise. -- More efficient arithmetic overflow checks by translating queries to a more [intelligent form](www.microsoft.com/en-us/research/wp-content/uploads/2016/02/z3prefix.pdf). ### Fixed diff --git a/hevm-cli/hevm-cli.hs b/hevm-cli/hevm-cli.hs --- a/hevm-cli/hevm-cli.hs +++ b/hevm-cli/hevm-cli.hs @@ -47,6 +47,7 @@ import qualified EVM.UnitTest import GHC.IO.Encoding +import GHC.Stack import Control.Concurrent.Async (async, waitCatch) import Control.Lens hiding (pre, passing) import Control.Monad (void, when, forM_, unless) @@ -54,14 +55,14 @@ import Data.ByteString (ByteString) import Data.List (intercalate, isSuffixOf) import Data.Tree -import Data.Text (Text, unpack, pack) +import Data.Text (unpack, pack) import Data.Text.Encoding (encodeUtf8) import Data.Text.IO (hPutStr) import Data.Maybe (fromMaybe, fromJust) import Data.Version (showVersion) import Data.SBV hiding (Word, solver, verbose, name) import Data.SBV.Control hiding (Version, timeout, create) -import System.IO (hFlush, stdout, stderr, utf8) +import System.IO (hFlush, stdout, stderr) import System.Directory (withCurrentDirectory, listDirectory) import System.Exit (exitFailure, exitWith, ExitCode(..)) import System.Environment (setEnv) @@ -731,7 +732,7 @@ caller' = addr caller 0 origin' = addr origin 0 calldata' = ConcreteBuffer $ bytes calldata "" - codeType = if create cmd then EVM.InitCode else EVM.RuntimeCode + codeType = (if create cmd then EVM.InitCode else EVM.RuntimeCode) . ConcreteBuffer address' = if create cmd then addr address (createAddress origin' (word nonce 0)) else addr address 0xacab @@ -752,10 +753,11 @@ , EVM.vmoptGasprice = word gasprice 0 , EVM.vmoptMaxCodeSize = word maxcodesize 0xffffffff , EVM.vmoptDifficulty = word difficulty diff - , EVM.vmoptSchedule = FeeSchedule.istanbul + , EVM.vmoptSchedule = FeeSchedule.berlin , EVM.vmoptChainId = word chainid 1 , EVM.vmoptCreate = create cmd , EVM.vmoptStorageModel = ConcreteS + , EVM.vmoptTxAccessList = mempty -- TODO: support me soon } word f def = fromMaybe def (f cmd) addr f def = fromMaybe def (f cmd) @@ -837,7 +839,7 @@ decipher = hexByteString "bytes" . strip0x block' = maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (block cmd) origin' = addr origin 0 - codeType = if create cmd then EVM.InitCode else EVM.RuntimeCode + codeType = (if create cmd then EVM.InitCode else EVM.RuntimeCode) . ConcreteBuffer address' = if create cmd then addr address (createAddress origin' (word nonce 0)) else addr address 0xacab @@ -857,15 +859,16 @@ , EVM.vmoptGasprice = word gasprice 0 , EVM.vmoptMaxCodeSize = word maxcodesize 0xffffffff , EVM.vmoptDifficulty = word difficulty diff - , EVM.vmoptSchedule = FeeSchedule.istanbul + , EVM.vmoptSchedule = FeeSchedule.berlin , EVM.vmoptChainId = word chainid 1 , EVM.vmoptCreate = create cmd , EVM.vmoptStorageModel = fromMaybe SymbolicS (storageModel cmd) + , EVM.vmoptTxAccessList = mempty } word f def = fromMaybe def (f cmd) addr f def = fromMaybe def (f cmd) -launchTest :: Command Options.Unwrapped -> IO () +launchTest :: HasCallStack => Command Options.Unwrapped -> IO () launchTest cmd = do #if MIN_VERSION_aeson(1, 0, 0) parsed <- VMTest.parseBCSuite <$> LazyByteString.readFile (file cmd) @@ -885,7 +888,7 @@ #endif #if MIN_VERSION_aeson(1, 0, 0) -runVMTest :: Bool -> Mode -> Maybe Int -> (String, VMTest.Case) -> IO Bool +runVMTest :: HasCallStack => Bool -> Mode -> Maybe Int -> (String, VMTest.Case) -> IO Bool runVMTest diffmode mode timelimit (name, x) = do let vm0 = VMTest.vmForCase x diff --git a/hevm.cabal b/hevm.cabal --- a/hevm.cabal +++ b/hevm.cabal @@ -2,7 +2,7 @@ name: hevm version: - 0.44.1 + 0.46.0 synopsis: Ethereum virtual machine evaluator description: @@ -104,7 +104,7 @@ filepath >= 1.4.2 && < 1.5, vty >= 5.25.1 && < 5.31, cereal >= 0.5.8 && < 0.6, - cryptonite >= 0.25 && < 0.28, + cryptonite >= 0.27 && < 0.29, memory >= 0.14.18 && < 0.16, data-dword >= 0.3.1 && < 0.4, fgl >= 5.7.0 && < 5.8, @@ -121,7 +121,7 @@ restless-git >= 0.7 && < 0.8, rosezipper >= 0.2 && < 0.3, s-cargot >= 0.1.4 && < 0.2, - sbv >= 8.7.5, + sbv >= 8.9, semver-range >= 0.2.7 && < 0.3, temporary >= 1.3 && < 1.4, text-format >= 0.3.2 && < 0.4, diff --git a/run-blockchain-tests b/run-blockchain-tests --- a/run-blockchain-tests +++ b/run-blockchain-tests @@ -46,7 +46,7 @@

hevm consensus test report

$(date +%Y-%m-%d)

$(echo "$npass passed, $nbal bad-balance, $nnon bad-nonce, $nstr bad-storage, $nfail failed, $nskip skipped, $ntime timeout")

-(Test suite: GeneralStateTests for Istanbul) +(Test suite: GeneralStateTests for Berlin)

Failed tests

@@ -82,14 +82,28 @@ { cd "$tests" for x in BlockchainTests/GeneralStateTests/*/*; do - if [[ $x =~ .*$match.* ]] && [[ -n $skip && $x =~ .*$skip.* ]]; then - for job in $(<$x jq '.|keys[]' -r); do - echo -n "$job " ; echo "skip" + if [ -d $x ]; then + for y in $x/*; do + if [[ $y =~ .*$match.* ]] && [[ -n $skip && $y =~ .*$skip.* ]]; then + for job in $(<$y jq '.|keys[]' -r); do + echo -n "$job " ; echo "skip" + done + elif [[ $y =~ .*$match.* ]]; then + set +e + "$HEVM" bc-test --file $y --timeout $timeout 2>&1 + set -e + fi done - elif [[ $x =~ .*$match.* ]]; then - set +e - "$HEVM" bc-test --file $x --timeout $timeout 2>&1 - set -e + else + if [[ $x =~ .*$match.* ]] && [[ -n $skip && $x =~ .*$skip.* ]]; then + for job in $(<$x jq '.|keys[]' -r); do + echo -n "$job " ; echo "skip" + done + elif [[ $x =~ .*$match.* ]]; then + set +e + "$HEVM" bc-test --file $x --timeout $timeout 2>&1 + set -e + fi fi done } | { diff --git a/src/EVM.hs b/src/EVM.hs --- a/src/EVM.hs +++ b/src/EVM.hs @@ -20,28 +20,27 @@ import EVM.ABI import EVM.Types import EVM.Solidity -import EVM.Concrete (createAddress, wordValue, keccakBlob, create2Address) +import EVM.Concrete (createAddress, wordValue, keccakBlob, create2Address, readMemoryWord) import EVM.Symbolic import EVM.Op import EVM.FeeSchedule (FeeSchedule (..)) import Options.Generic as Options import qualified EVM.Precompiled -import Data.Text (Text) -import Data.Word (Word8, Word32) import Control.Lens hiding (op, (:<), (|>), (.>)) import Control.Monad.State.Strict hiding (state) import Data.ByteString (ByteString) import Data.ByteString.Lazy (fromStrict) import Data.Map.Strict (Map) +import Data.Set (Set, insert, member, fromList) import Data.Maybe (fromMaybe) -import Data.Semigroup (Semigroup (..)) import Data.Sequence (Seq) import Data.Vector.Storable (Vector) import Data.Foldable (toList) import Data.Tree +import Data.List (find) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LS @@ -57,7 +56,10 @@ import Crypto.Number.ModArithmetic (expFast) import qualified Crypto.Hash as Crypto -import Crypto.Hash (Digest, SHA256, RIPEMD160) +import Crypto.Hash (Digest, SHA256, RIPEMD160, digestFromByteString) +import Crypto.PubKey.ECC.ECDSA (signDigestWith, PrivateKey(..), Signature(..)) +import Crypto.PubKey.ECC.Types (getCurveByName, CurveName(..), Point(..)) +import Crypto.PubKey.ECC.Generate (generateQ) -- * Data types @@ -200,6 +202,7 @@ , vmoptChainId :: W256 , vmoptCreate :: Bool , vmoptStorageModel :: StorageModel + , vmoptTxAccessList :: Map Addr [W256] } deriving Show -- | A log entry @@ -238,7 +241,7 @@ data FrameState = FrameState { _contract :: Addr , _codeContract :: Addr - , _code :: ByteString + , _code :: Buffer , _pc :: Int , _stack :: [SymWord] , _memory :: Buffer @@ -254,14 +257,14 @@ -- | The state that spans a whole transaction data TxState = TxState - { _gasprice :: Word - , _txgaslimit :: Word - , _origin :: Addr - , _toAddr :: Addr - , _value :: SymWord - , _substate :: SubState - , _isCreate :: Bool - , _txReversion :: Map Addr Contract + { _gasprice :: Word + , _txgaslimit :: Word + , _origin :: Addr + , _toAddr :: Addr + , _value :: SymWord + , _substate :: SubState + , _isCreate :: Bool + , _txReversion :: Map Addr Contract } deriving (Show) @@ -269,6 +272,8 @@ data SubState = SubState { _selfdestructs :: [Addr] , _touchedAccounts :: [Addr] + , _accessedAddresses :: Set Addr + , _accessedStorageKeys :: Set (Addr, W256) , _refunds :: [(Addr, Integer)] -- in principle we should include logs here, but do not for now } @@ -279,9 +284,9 @@ -- by instructions like @EXTCODEHASH@, so we distinguish these two -- code types. data ContractCode - = InitCode ByteString -- ^ "Constructor" code, during contract creation - | RuntimeCode ByteString -- ^ "Instance" code, after contract creation - deriving (Show, Eq) + = InitCode Buffer -- ^ "Constructor" code, during contract creation + | RuntimeCode Buffer -- ^ "Instance" code, after contract creation + deriving (Show) -- | A contract can either have concrete or symbolic storage -- depending on what type of execution we are doing @@ -313,7 +318,6 @@ } deriving instance Show Contract -deriving instance Eq Contract -- | When doing symbolic execution, we have three different -- ways to model the storage of contracts. This determines @@ -385,9 +389,9 @@ -- | An "external" view of a contract's bytecode, appropriate for -- e.g. @EXTCODEHASH@. -bytecode :: Getter Contract ByteString +bytecode :: Getter Contract Buffer bytecode = contractcode . to f - where f (InitCode _) = BS.empty + where f (InitCode _) = mempty f (RuntimeCode b) = b instance Semigroup Cache where @@ -420,16 +424,25 @@ -- * Data constructors makeVm :: VMOpts -> VM -makeVm o = VM +makeVm o = + let txaccessList = vmoptTxAccessList o + txorigin = vmoptOrigin o + txtoAddr = vmoptAddress o + initialAccessedAddrs = fromList $ [txorigin, txtoAddr] ++ [1..9] ++ (Map.keys txaccessList) + initialAccessedStorageKeys = fromList $ foldMap (uncurry (map . (,))) (Map.toList txaccessList) + touched = if vmoptCreate o then [txorigin] else [txorigin, txtoAddr] + in + VM { _result = Nothing , _frames = mempty , _tx = TxState { _gasprice = w256 $ vmoptGasprice o , _txgaslimit = w256 $ vmoptGaslimit o - , _origin = vmoptOrigin o - , _toAddr = vmoptAddress o + , _origin = txorigin + , _toAddr = txtoAddr , _value = vmoptValue o - , _substate = SubState mempty mempty mempty + , _substate = SubState mempty touched initialAccessedAddrs initialAccessedStorageKeys mempty + --, _accessList = txaccessList , _isCreate = vmoptCreate o , _txReversion = Map.fromList [(vmoptAddress o, vmoptContract o)] @@ -481,8 +494,10 @@ initialContract theContractCode = Contract { _contractcode = theContractCode , _codehash = - if BS.null theCode then 0 else - keccak (stripBytecodeMetadata theCode) + case theCode of + ConcreteBuffer b -> keccak (stripBytecodeMetadata b) + SymbolicBuffer _ -> 0 + , _storage = Concrete mempty , _balance = 0 , _nonce = if creation then 1 else 0 @@ -552,23 +567,24 @@ _ -> underrun - else if the state pc >= num (BS.length (the state code)) + else if the state pc >= len (the state code) then doStop else do - let ?op = BS.index (the state code) (the state pc) + let ?op = fromMaybe (error "could not analyze symbolic code") $ unliteral $ EVM.Symbolic.index (the state pc) (the state code) case ?op of -- op: PUSH x | x >= 0x60 && x <= 0x7f -> do let !n = num x - 0x60 + 1 - !xs = padRight n $ BS.take n (BS.drop (1 + the state pc) - (the state code)) + !xs = case the state code of + ConcreteBuffer b -> w256lit $ word $ padRight n $ BS.take n (BS.drop (1 + the state pc) b) + SymbolicBuffer b -> readSWord' 0 $ padLeft' 32 $ take n $ drop (1 + the state pc) b limitStack 1 $ burn g_verylow $ do next - push (w256 (word xs)) + pushSym xs -- op: DUP x | x >= 0x80 && x <= 0x8f -> do @@ -730,7 +746,7 @@ 0x31 -> case stk of (x':xs) -> forceConcrete x' $ \x -> - burn g_balance $ + accessAndBurn (num x) $ fetchAccount (num x) $ \c -> do next assign (state . stack) xs @@ -784,7 +800,7 @@ -- op: CODESIZE 0x38 -> limitStack 1 . burn g_base $ - next >> push (num (BS.length (the state code))) + next >> push (num (len (the state code))) -- op: CODECOPY 0x39 -> @@ -794,7 +810,7 @@ accessUnboundedMemoryRange fees memOffset n $ do next assign (state . stack) xs - copyBytesToMemory (ConcreteBuffer (the state code)) + copyBytesToMemory (the state code) n codeOffset memOffset _ -> underrun @@ -813,11 +829,11 @@ assign (state . stack) xs push (w256 1) else - burn g_extcode $ + accessAndBurn (num x) $ fetchAccount (num x) $ \c -> do next assign (state . stack) xs - push (num (BS.length (view bytecode c))) + push (num (len (view bytecode c))) [] -> underrun @@ -830,13 +846,15 @@ : codeSize' : xs ) -> forceConcrete4 (extAccount', memOffset', codeOffset', codeSize') $ - \(extAccount, memOffset, codeOffset, codeSize) -> - burn (g_extcode + g_copy * ceilDiv (num codeSize) 32) $ + \(extAccount, memOffset, codeOffset, codeSize) -> do + acc <- accessAccountForGas (num extAccount) + let cost = if acc then g_warm_storage_read else g_cold_account_access + burn (cost + g_copy * ceilDiv (num codeSize) 32) $ accessUnboundedMemoryRange fees memOffset codeSize $ fetchAccount (num extAccount) $ \c -> do next assign (state . stack) xs - copyBytesToMemory (ConcreteBuffer (view bytecode c)) + copyBytesToMemory (view bytecode c) codeSize codeOffset memOffset _ -> underrun @@ -854,7 +872,7 @@ accessUnboundedMemoryRange fees xTo xSize $ do next assign (state . stack) xs - if len (the state returndata) < num xFrom + num xSize + if num (len (the state returndata)) < xFrom + xSize || xFrom + xSize < xFrom then vmError InvalidMemoryAccess else copyBytesToMemory (the state returndata) xSize xFrom xTo _ -> underrun @@ -863,13 +881,15 @@ 0x3f -> case stk of (x':xs) -> forceConcrete x' $ \x -> - burn g_extcodehash $ do + accessAndBurn (num x) $ do next assign (state . stack) xs fetchAccount (num x) $ \c -> if accountEmpty c then push (num (0 :: Int)) - else push (num (keccak (view bytecode c))) + else case view bytecode c of + ConcreteBuffer b -> push (num (keccak b)) + b'@(SymbolicBuffer b) -> pushSym (S (FromKeccak b') $ symkeccak' b) [] -> underrun @@ -962,8 +982,10 @@ -- op: SLOAD 0x54 -> case stk of - (x:xs) -> - burn g_sload $ + (x:xs) -> do + acc <- accessStorageForGas self x + let cost = if acc then g_warm_storage_read else g_cold_sload + burn cost $ accessStorage self x $ \y -> do next assign (state . stack) (y:xs) @@ -983,7 +1005,7 @@ let original = case view storage this of Concrete _ -> fromMaybe 0 (Map.lookup (forceLit x) (view origStorage this)) Symbolic _ _ -> 0 -- we don't use this value anywhere anyway - cost = case (maybeLitWord current, maybeLitWord new) of + storage_cost = case (maybeLitWord current, maybeLitWord new) of (Just current', Just new') -> if (current' == new') then g_sload else if (current' == original) && (original == 0) then g_sset @@ -994,7 +1016,9 @@ -- assume worst case scenario _ -> g_sset - burn cost $ do + acc <- accessStorageForGas self x + let cold_storage_cost = if acc then 0 else g_cold_sload + burn (storage_cost + cold_storage_cost) $ do next assign (state . stack) xs modifying (env . contracts . ix self . storage) @@ -1088,8 +1112,10 @@ let newAddr = createAddress self (wordValue (view nonce this)) (cost, gas') = costOfCreate fees availableGas 0 - burn (cost - gas') $ forceConcreteBuffer (readMemory (num xOffset) (num xSize) vm) $ \initCode -> - create self this (num gas') xValue xs newAddr initCode + _ <- accessAccountForGas newAddr + burn (cost - gas') $ + let initCode = readMemory (num xOffset) (num xSize) vm + in create self this (num gas') xValue xs newAddr initCode _ -> underrun -- op: CALL @@ -1203,12 +1229,14 @@ \(xValue, xOffset, xSize, xSalt) -> accessMemoryRange fees xOffset xSize $ do availableGas <- use (state . gas) - forceConcreteBuffer (readMemory (num xOffset) (num xSize) vm) $ \initCode -> + + forceConcreteBuffer (readMemory (num xOffset) (num xSize) vm) $ \initCode -> do let newAddr = create2Address self (num xSalt) initCode (cost, gas') = costOfCreate fees availableGas xSize - in burn (cost - gas') $ - create self this (num gas') xValue xs newAddr initCode + _ <- accessAccountForGas newAddr + burn (cost - gas') $ + create self this (num gas') xValue xs newAddr (ConcreteBuffer initCode) _ -> underrun -- op: STATICCALL @@ -1239,14 +1267,15 @@ notStatic $ case stk of [] -> underrun - (xTo':_) -> forceConcrete xTo' $ \(num -> xTo) -> - let - funds = view balance this - recipientExists = accountExists xTo vm - c_new = if not recipientExists && funds /= 0 - then num g_selfdestruct_newaccount - else 0 - in burn (g_selfdestruct + c_new) $ do + (xTo':_) -> forceConcrete xTo' $ \(num -> xTo) -> do + acc <- accessAccountForGas (num xTo) + let cost = if acc then 0 else g_cold_account_access + funds = view balance this + recipientExists = accountExists xTo vm + c_new = if not recipientExists && funds /= 0 + then num g_selfdestruct_newaccount + else 0 + burn (g_selfdestruct + c_new + cost) $ do destructs <- use (tx . substate . selfdestructs) unless (elem self destructs) $ refund r_selfdestruct selfdestruct self @@ -1280,18 +1309,18 @@ -- | Checks a *CALL for failure; OOG, too many callframes, memory access etc. callChecks :: (?op :: Word8) - => Contract -> Word -> Addr -> Word -> Word -> Word -> Word -> Word -> [SymWord] + => Contract -> Word -> Addr -> Addr -> Word -> Word -> Word -> Word -> Word -> [SymWord] -- continuation with gas available for call -> (Integer -> EVM ()) -> EVM () -callChecks this xGas xContext xValue xInOffset xInSize xOutOffset xOutSize xs continue = do +callChecks this xGas xContext xTo xValue xInOffset xInSize xOutOffset xOutSize xs continue = do vm <- get let fees = view (block . schedule) vm accessMemoryRange fees xInOffset xInSize $ accessMemoryRange fees xOutOffset xOutSize $ do availableGas <- use (state . gas) let recipientExists = accountExists xContext vm - (cost, gas') = costOfCall fees recipientExists xValue availableGas xGas + (cost, gas') <- costOfCall fees recipientExists xValue availableGas xGas xTo burn (cost - gas') $ do if xValue > view balance this then do @@ -1318,7 +1347,7 @@ -> [SymWord] -> EVM () precompiledContract this xGas precompileAddr recipient xValue inOffset inSize outOffset outSize xs = - callChecks this xGas recipient xValue inOffset inSize outOffset outSize xs $ \gas' -> + callChecks this xGas recipient precompileAddr xValue inOffset inSize outOffset outSize xs $ \gas' -> do executePrecompile precompileAddr gas' inOffset inSize outOffset outSize xs self <- use (state . contract) @@ -1333,7 +1362,6 @@ transfer self recipient xValue touchAccount self touchAccount recipient - touchAccount precompileAddr _ -> vmError UnexpectedSymbolicArg _ -> underrun @@ -1418,16 +1446,15 @@ (lenb, lene, lenm) = parseModexpLength input' output = ConcreteBuffer $ - case (isZero (96 + lenb + lene) lenm input') of - True -> - truncpadlit (num lenm) (asBE (0 :: Int)) - False -> - let - b = asInteger $ lazySlice 96 lenb input' - e = asInteger $ lazySlice (96 + lenb) lene input' - m = asInteger $ lazySlice (96 + lenb + lene) lenm input' - in - padLeft (num lenm) (asBE (expFast b e m)) + if isZero (96 + lenb + lene) lenm input' + then truncpadlit (num lenm) (asBE (0 :: Int)) + else + let + b = asInteger $ lazySlice 96 lenb input' + e = asInteger $ lazySlice (96 + lenb) lene input' + m = asInteger $ lazySlice (96 + lenb + lene) lenm input' + in + padLeft (num lenm) (asBE (expFast b e m)) in do assign (state . stack) (1 : xs) assign (state . returndata) output @@ -1511,6 +1538,7 @@ lenm = w256 $ word $ LS.toStrict $ lazySlice 64 96 input in (lenb, lene, lenm) +--- checks if a range of ByteString bs starting at offset and length size is all zeros. isZero :: Word -> Word -> ByteString -> Bool isZero offset size bs = LS.all (== 0) $ @@ -1660,7 +1688,9 @@ -- EIP 161 accountEmpty :: Contract -> Bool accountEmpty c = - (view contractcode c == RuntimeCode mempty) + case view contractcode c of + RuntimeCode b -> len b == 0 + _ -> False && (view nonce c == 0) && (view balance c == 0) @@ -1669,7 +1699,7 @@ finalize = do let revertContracts = use (tx . txReversion) >>= assign (env . contracts) - revertSubstate = assign (tx . substate) (SubState mempty mempty mempty) + revertSubstate = assign (tx . substate) (SubState mempty mempty mempty mempty mempty) use result >>= \case Nothing -> @@ -1688,7 +1718,7 @@ createe <- use (state . contract) createeExists <- (Map.member createe) <$> use (env . contracts) - when (creation && createeExists) $ forceConcreteBuffer output $ \code' -> replaceCode createe (RuntimeCode code') + when (creation && createeExists) $ replaceCode createe (RuntimeCode output) -- compute and pay the refund to the caller and the -- corresponding payment to the miner @@ -1845,6 +1875,35 @@ selfdestruct :: Addr -> EVM() selfdestruct = pushTo ((tx . substate) . selfdestructs) +accessAndBurn :: Addr -> EVM () -> EVM () +accessAndBurn x cont = do + FeeSchedule {..} <- use ( block . schedule ) + acc <- accessAccountForGas x + let cost = if acc then g_warm_storage_read else g_cold_account_access + burn cost cont + +-- | returns a wrapped boolean- if true, this address has been touched before in the txn (warm gas cost as in EIP 2929) +-- otherwise cold +accessAccountForGas :: Addr -> EVM Bool +accessAccountForGas addr = do + accessedAddrs <- use (tx . substate . accessedAddresses) + let accessed = member addr accessedAddrs + assign (tx . substate . accessedAddresses) (insert addr accessedAddrs) + return accessed + +-- | returns a wrapped boolean- if true, this slot has been touched before in the txn (warm gas cost as in EIP 2929) +-- otherwise cold +accessStorageForGas :: Addr -> SymWord -> EVM Bool +accessStorageForGas addr key = do + accessedStrkeys <- use (tx . substate . accessedStorageKeys) + case maybeLitWord key of + Just litword -> do + let litword256 = wordValue litword + let accessed = member (addr, litword256) accessedStrkeys + assign (tx . substate . accessedStorageKeys) (insert (addr, litword256) accessedStrkeys) + return accessed + _ -> return False + -- * Cheat codes -- The cheat code is 7109709ecfa91a80626ff3989d68f67f5b1dd12d. @@ -1882,36 +1941,87 @@ Map.fromList [ action "warp(uint256)" $ \sig _ _ input -> case decodeStaticArgs input of - [x] -> assign (block . timestamp) (mksym x) + [x] -> assign (block . timestamp) x _ -> vmError (BadCheatCode sig), action "roll(uint256)" $ \sig _ _ input -> case decodeStaticArgs input of - [x] -> forceConcrete (mksym x) (assign (block . number)) + [x] -> forceConcrete x (assign (block . number)) _ -> vmError (BadCheatCode sig), action "store(address,bytes32,bytes32)" $ \sig _ _ input -> case decodeStaticArgs input of [a, slot, new] -> - makeUnique (mksym $ sFromIntegral a) $ \(C _ (num -> a')) -> + makeUnique a $ \(C _ (num -> a')) -> fetchAccount a' $ \_ -> do - modifying (env . contracts . ix a' . storage) (writeStorage (mksym slot) (mksym new)) + modifying (env . contracts . ix a' . storage) (writeStorage slot new) _ -> vmError (BadCheatCode sig), action "load(address,bytes32)" $ \sig outOffset _ input -> case decodeStaticArgs input of [a, slot] -> - makeUnique (mksym $ sFromIntegral a) $ \(C _ (num -> a'))-> - accessStorage a' (mksym slot) $ \res -> do + makeUnique a $ \(C _ (num -> a'))-> + accessStorage a' slot $ \res -> do assign (state . returndata . word256At 0) res assign (state . memory . word256At outOffset) res + _ -> vmError (BadCheatCode sig), + + action "sign(uint256,bytes32)" $ + \sig outOffset _ input -> case decodeStaticArgs input of + [sk, hash] -> + forceConcrete sk $ \sk' -> + forceConcrete hash $ \(C _ hash') -> let + curve = getCurveByName SEC_p256k1 + priv = PrivateKey curve (num sk') + digest = digestFromByteString (word256Bytes hash') + in do + case digest of + Nothing -> vmError (BadCheatCode sig) + Just digest' -> do + let s = ethsign priv digest' + v = if (sign_s s) % 2 == 0 then 27 else 28 + encoded = encodeAbiValue $ + AbiTuple (RegularVector.fromList + [ AbiUInt 8 v + , AbiBytes 32 (word256Bytes . fromInteger $ sign_r s) + , AbiBytes 32 (word256Bytes . fromInteger $ sign_s s) + ]) + assign (state . returndata) (ConcreteBuffer encoded) + copyBytesToMemory (ConcreteBuffer encoded) (num . BS.length $ encoded) 0 outOffset + _ -> vmError (BadCheatCode sig), + + action "addr(uint256)" $ + \sig outOffset _ input -> case decodeStaticArgs input of + [sk] -> forceConcrete sk $ \sk' -> let + curve = getCurveByName SEC_p256k1 + pubPoint = generateQ curve (num sk') + encodeInt = encodeAbiValue . AbiUInt 256 . fromInteger + in do + case pubPoint of + PointO -> do vmError (BadCheatCode sig) + Point x y -> do + -- See yellow paper #286 + let + pub = BS.concat [ encodeInt x, encodeInt y ] + addr = w256lit . num . word256 . BS.drop 12 . BS.take 32 . keccakBytes $ pub + assign (state . returndata . word256At 0) addr + assign (state . memory . word256At outOffset) addr _ -> vmError (BadCheatCode sig) + ] where action s f = (abiKeccak s, f (Just $ abiKeccak s)) - mksym x = S (Todo "abidecode" []) x +-- | Hack deterministic signing, totally insecure... +ethsign :: PrivateKey -> Digest Crypto.Keccak_256 -> Signature +ethsign sk digest = go 420 + where + go k = case signDigestWith k sk digest of + Nothing -> go (k + 1) + Just sig -> sig + -- * General call implementation ("delegateCall") +-- note that the continuation is ignored in the precompile case delegateCall :: (?op :: Word8) => Contract -> Word -> SAddr -> SAddr -> Word -> Word -> Word -> Word -> Word -> [SymWord] @@ -1927,7 +2037,7 @@ assign (state . stack) xs cheat (xInOffset, xInSize) (xOutOffset, xOutSize) else - callChecks this gasGiven xContext' xValue xInOffset xInSize xOutOffset xOutSize xs $ + callChecks this gasGiven xContext' xTo' xValue xInOffset xInSize xOutOffset xOutSize xs $ \xGas -> do vm0 <- get fetchAccount xTo' . const $ @@ -1980,12 +2090,14 @@ -- EIP 684 collision :: Maybe Contract -> Bool collision c' = case c' of - Just c -> (view contractcode c /= RuntimeCode mempty) || (view nonce c /= 0) + Just c -> (view nonce c /= 0) || case view contractcode c of + RuntimeCode b -> len b /= 0 + _ -> True Nothing -> False create :: (?op :: Word8) => Addr -> Contract - -> Word -> Word -> [SymWord] -> Addr -> ByteString -> EVM () + -> Word -> Word -> [SymWord] -> Addr -> Buffer -> EVM () create self this xGas' xValue xs newAddr initCode = do vm0 <- get let xGas = num xGas' @@ -2151,9 +2263,19 @@ -- Were we calling? CallContext _ _ (num -> outOffset) (num -> outSize) _ _ _ reversion substate' -> do + -- Excerpt K.1. from the yellow paper: + -- K.1. Deletion of an Account Despite Out-of-gas. + -- At block 2675119, in the transaction 0xcf416c536ec1a19ed1fb89e4ec7ffb3cf73aa413b3aa9b77d60e4fd81a4296ba, + -- an account at address 0x03 was called and an out-of-gas occurred during the call. + -- Against the equation (197), this added 0x03 in the set of touched addresses, and this transaction turned σ[0x03] into ∅. + + -- In other words, we special case address 0x03 and keep it in the set of touched accounts during revert + touched <- use (tx . substate . touchedAccounts) + let + substate'' = over touchedAccounts (maybe id cons (find ((==) 3) touched)) substate' revertContracts = assign (env . contracts) reversion - revertSubstate = assign (tx . substate) substate' + revertSubstate = assign (tx . substate) substate'' case how of -- Case 1: Returning from a call? @@ -2191,9 +2313,8 @@ case how of -- Case 4: Returning during a creation? - FrameReturned output -> - forceConcreteBuffer output $ \output' -> do - replaceCode createe (RuntimeCode output') + FrameReturned output -> do + replaceCode createe (RuntimeCode output) assign (state . returndata) mempty reclaimRemainingGasAllowance push (num createe) @@ -2273,7 +2394,7 @@ => Word -> (SymWord -> f (SymWord)) -> Buffer -> f Buffer word256At i = lens getter setter where - getter = readMemoryWord i + getter = EVM.Symbolic.readMemoryWord i setter m x = setMemoryWord i x m -- * Tracing @@ -2385,7 +2506,7 @@ self <- use (state . codeContract) theCodeOps <- use (env . contracts . ix self . codeOps) theOpIxMap <- use (env . contracts . ix self . opIxMap) - if x < num (BS.length theCode) && BS.index theCode (num x) == 0x5b + if x < num (len theCode) && 0x5b == (fromMaybe (error "tried to jump to symbolic code location") $ unliteral $ EVM.Symbolic.index (num x) theCode) then if OpJumpdest == snd (theCodeOps RegularVector.! (theOpIxMap Vector.! num x)) then do @@ -2402,14 +2523,22 @@ -- Index i of the resulting vector contains the operation index for -- the program counter value i. This is needed because source map -- entries are per operation, not per byte. -mkOpIxMap :: ByteString -> Vector Int -mkOpIxMap xs = Vector.create $ Vector.new (BS.length xs) >>= \v -> +mkOpIxMap :: Buffer -> Vector Int +mkOpIxMap xs = Vector.create $ Vector.new (len xs) >>= \v -> -- Loop over the byte string accumulating a vector-mutating action. -- This is somewhat obfuscated, but should be fast. - let (_, _, _, m) = - BS.foldl' (go v) (0 :: Word8, 0, 0, return ()) xs - in m >> return v + case xs of + ConcreteBuffer xs' -> + let (_, _, _, m) = + BS.foldl' (go v) (0 :: Word8, 0, 0, return ()) xs' + in m >> return v + SymbolicBuffer xs' -> + let (_, _, _, m) = + foldl (go' v) (0, 0, 0, return ()) (stripBytecodeMetadataSym xs') + in m >> return v + where + -- concrete case go v (0, !i, !j, !m) x | x >= 0x60 && x <= 0x7f = {- Start of PUSH op. -} (x - 0x60 + 1, i + 1, j, m >> Vector.write v i j) go v (1, !i, !j, !m) _ = @@ -2419,14 +2548,34 @@ go v (n, !i, !j, !m) _ = {- PUSH data. -} (n - 1, i + 1, j, m >> Vector.write v i j) + -- symbolic case + go' v (0, !i, !j, !m) x = case unliteral x of + Just x' -> if x' >= 0x60 && x' <= 0x7f + -- start of PUSH op -- + then (x' - 0x60 + 1, i + 1, j, m >> Vector.write v i j) + -- other data -- + else (0, i + 1, j + 1, m >> Vector.write v i j) + _ -> error "cannot analyze symbolic code" + + {- Start of PUSH op. -} (x - 0x60 + 1, i + 1, j, m >> Vector.write v i j) + go' v (1, !i, !j, !m) _ = + {- End of PUSH op. -} (0, i + 1, j + 1, m >> Vector.write v i j) + go' v (n, !i, !j, !m) _ = + {- PUSH data. -} (n - 1, i + 1, j, m >> Vector.write v i j) + vmOp :: VM -> Maybe Op vmOp vm = let i = vm ^. state . pc - xs = BS.drop i (vm ^. state . code) - op = BS.index xs 0 - in if BS.null xs + code' = vm ^. state . code + xs = case code' of + ConcreteBuffer xs' -> ConcreteBuffer (BS.drop i xs') + SymbolicBuffer xs' -> SymbolicBuffer (drop i xs') + op = case xs of + ConcreteBuffer b -> BS.index b 0 + SymbolicBuffer b -> fromSized $ fromMaybe (error "unexpected symbolic code") (unliteral (b !! 0)) + in if (len code' < i) then Nothing - else Just (readOp op (BS.drop 1 xs)) + else Just (readOp op xs) vmOpIx :: VM -> Maybe Int vmOpIx vm = @@ -2461,14 +2610,16 @@ then Map.fromList (zip xs (vm ^. state . stack)) else mempty -readOp :: Word8 -> ByteString -> Op +readOp :: Word8 -> Buffer -> Op readOp x _ | x >= 0x80 && x <= 0x8f = OpDup (x - 0x80 + 1) readOp x _ | x >= 0x90 && x <= 0x9f = OpSwap (x - 0x90 + 1) readOp x _ | x >= 0xa0 && x <= 0xa4 = OpLog (x - 0xa0) readOp x xs | x >= 0x60 && x <= 0x7f = let n = x - 0x60 + 1 - xs' = BS.take (num n) xs - in OpPush (word xs') + xs'' = case xs of + ConcreteBuffer xs' -> num $ EVM.Concrete.readMemoryWord 0 $ BS.take (num n) xs' + SymbolicBuffer xs' -> readSWord' 0 $ take (num n) xs' + in OpPush xs'' readOp x _ = case x of 0x00 -> OpStop 0x01 -> OpAdd @@ -2544,8 +2695,8 @@ 0xff -> OpSelfdestruct _ -> OpUnknown x -mkCodeOps :: ByteString -> RegularVector.Vector (Int, Op) -mkCodeOps bytes = RegularVector.fromList . toList $ go 0 bytes +mkCodeOps :: Buffer -> RegularVector.Vector (Int, Op) +mkCodeOps (ConcreteBuffer bytes) = RegularVector.fromList . toList $ go 0 bytes where go !i !xs = case BS.uncons xs of @@ -2553,34 +2704,40 @@ mempty Just (x, xs') -> let j = opSize x - in (i, readOp x xs') Seq.<| go (i + j) (BS.drop j xs) + in (i, readOp x (ConcreteBuffer xs')) Seq.<| go (i + j) (BS.drop j xs) +mkCodeOps (SymbolicBuffer bytes) = RegularVector.fromList . toList $ go' 0 (stripBytecodeMetadataSym bytes) + where + go' !i !xs = + case uncons xs of + Nothing -> + mempty + Just (x, xs') -> + let x' = fromSized $ fromMaybe (error "unexpected symbolic code argument") $ unliteral x + j = opSize x' + in (i, readOp x' (SymbolicBuffer xs')) Seq.<| go' (i + j) (drop j xs) -- * Gas cost calculation helpers -- Gas cost function for CALL, transliterated from the Yellow Paper. costOfCall :: FeeSchedule Integer - -> Bool -> Word -> Word -> Word - -> (Integer, Integer) -costOfCall (FeeSchedule {..}) recipientExists xValue availableGas' xGas' = - (c_gascap + c_extra, c_callgas) - where - availableGas = num availableGas' - xGas = num xGas' - c_extra = - num g_call + c_xfer + c_new - c_xfer = - if xValue /= 0 then num g_callvalue else 0 - c_callgas = - if xValue /= 0 then c_gascap + num g_callstipend else c_gascap - c_new = - if not recipientExists && xValue /= 0 - then num g_newaccount - else 0 - c_gascap = - if availableGas >= c_extra - then min xGas (allButOne64th (availableGas - c_extra)) - else xGas + -> Bool -> Word -> Word -> Word -> Addr + -> EVM (Integer, Integer) +costOfCall (FeeSchedule {..}) recipientExists xValue availableGas' xGas' target = do + acc <- accessAccountForGas target + let call_base_gas = if acc then g_warm_storage_read else g_cold_account_access + availableGas = num availableGas' + xGas = num xGas' + c_new = if not recipientExists && xValue /= 0 + then num g_newaccount + else 0 + c_xfer = if xValue /= 0 then num g_callvalue else 0 + c_extra = num call_base_gas + c_xfer + c_new + c_gascap = if availableGas >= c_extra + then min xGas (allButOne64th (availableGas - c_extra)) + else xGas + c_callgas = if xValue /= 0 then c_gascap + num g_callstipend else c_gascap + return (c_gascap + c_extra, c_callgas) -- Gas cost of create, including hash cost if needed costOfCreate @@ -2594,6 +2751,22 @@ hashCost = g_sha3word * ceilDiv (num hashSize) 32 initGas = allButOne64th (availableGas - createCost) +concreteModexpGasFee :: ByteString -> Integer +concreteModexpGasFee input = max 200 ((multiplicationComplexity * iterCount) `div` 3) + where (lenb, lene, lenm) = parseModexpLength input + ez = isZero (96 + lenb) lene input + e' = w256 $ word $ LS.toStrict $ + lazySlice (96 + lenb) (min 32 lene) input + nwords :: Integer + nwords = ceilDiv (num $ max lenb lenm) 8 + multiplicationComplexity = nwords * nwords + iterCount' :: Integer + iterCount' | lene <= 32 && ez = 0 + | lene <= 32 = num (log2 e') + | e' == 0 = 8 * (num lene - 32) + | otherwise = num (log2 e') + 8 * (num lene - 32) + iterCount = max iterCount' 1 + -- Gas cost of precompiles costOfPrecompile :: FeeSchedule Integer -> Addr -> Buffer -> Integer costOfPrecompile (FeeSchedule {..}) precompileAddr input = @@ -2607,24 +2780,10 @@ -- IDENTITY 0x4 -> num $ (((len input + 31) `div` 32) * 3) + 15 -- MODEXP - 0x5 -> num $ (f (num (max lenm lenb)) * num (max lene' 1)) `div` (num g_quaddivisor) + 0x5 -> concreteModexpGasFee input' where input' = case input of - SymbolicBuffer _ -> error "unsupported: symbolic MODEXP gas cost calc" - ConcreteBuffer b -> b - (lenb, lene, lenm) = parseModexpLength input' - lene' | lene <= 32 && ez = 0 - | lene <= 32 = num (log2 e') - | e' == 0 = 8 * (lene - 32) - | otherwise = num (log2 e') + 8 * (lene - 32) - - ez = isZero (96 + lenb) lene input' - e' = w256 $ word $ LS.toStrict $ - lazySlice (96 + lenb) (min 32 lene) input' - - f :: Integer -> Integer - f x | x <= 64 = x * x - | x <= 1024 = (x * x) `div` 4 + 96 * x - 3072 - | otherwise = (x * x) `div` 16 + 480 * x - 199680 + SymbolicBuffer _ -> error "unsupported: symbolic MODEXP gas cost calc" + ConcreteBuffer b -> b -- ECADD 0x6 -> g_ecadd -- ECMUL diff --git a/src/EVM/ABI.hs b/src/EVM/ABI.hs --- a/src/EVM/ABI.hs +++ b/src/EVM/ABI.hs @@ -32,6 +32,7 @@ ( AbiValue (..) , AbiType (..) , AbiKind (..) + , AbiVals (..) , abiKind , Event (..) , Anonymity (..) @@ -42,12 +43,12 @@ , genAbiValue , abiValueType , abiTypeSolidity - , abiCalldata , abiMethod , emptyAbi , encodeAbiValue , decodeAbiValue , decodeStaticArgs + , decodeBuffer , formatString , parseTypeName , makeAbiValue @@ -64,14 +65,12 @@ import Data.ByteString (ByteString) import Data.DoubleWord (Word256, Int256, signedWord) import Data.Functor (($>)) -import Data.Monoid ((<>)) import Data.Text (Text, pack, unpack) import Data.Text.Encoding (encodeUtf8, decodeUtf8') import Data.Vector (Vector, toList) import Data.Word (Word32) import Data.List (intercalate) -import Data.SBV (SWord, fromBytes, sFromIntegral, literal) -import Data.Maybe +import Data.SBV (SWord, fromBytes) import GHC.Generics import Test.QuickCheck hiding ((.&.), label) @@ -276,22 +275,6 @@ Static -> pure () Dynamic -> putAbi x -abiValueSize :: AbiValue -> Int -abiValueSize x = - case x of - AbiUInt _ _ -> 32 - AbiInt _ _ -> 32 - AbiBytes n _ -> roundTo32Bytes n - AbiAddress _ -> 32 - AbiBool _ -> 32 - AbiArray _ _ xs -> Vector.sum (Vector.map abiHeadSize xs) + - Vector.sum (Vector.map abiTailSize xs) - AbiBytesDynamic xs -> 32 + roundTo32Bytes (BS.length xs) - AbiArrayDynamic _ xs -> 32 + Vector.sum (Vector.map abiHeadSize xs) + - Vector.sum (Vector.map abiTailSize xs) - AbiString s -> 32 + roundTo32Bytes (BS.length s) - AbiTuple v -> sum (abiValueSize <$> v) - abiTailSize :: AbiValue -> Int abiTailSize x = case abiKind (abiValueType x) of @@ -300,13 +283,10 @@ case x of AbiString s -> 32 + roundTo32Bytes (BS.length s) AbiBytesDynamic s -> 32 + roundTo32Bytes (BS.length s) - AbiArrayDynamic _ xs -> 32 + Vector.sum (Vector.map abiValueSize xs) - AbiArray _ _ xs -> Vector.sum (Vector.map abiValueSize xs) - AbiTuple v -> sum (headSize <$> v) + sum (abiTailSize <$> v) + AbiArrayDynamic _ xs -> 32 + sum ((abiHeadSize <$> xs) <> (abiTailSize <$> xs)) + AbiArray _ _ xs -> sum ((abiHeadSize <$> xs) <> (abiTailSize <$> xs)) + AbiTuple v -> sum ((abiHeadSize <$> v) <> (abiTailSize <$> v)) _ -> error "impossible" - where headSize y = if abiKind (abiValueType y) == Static - then abiValueSize y - else 32 abiHeadSize :: AbiValue -> Int abiHeadSize x = @@ -319,25 +299,23 @@ AbiBytes n _ -> roundTo32Bytes n AbiAddress _ -> 32 AbiBool _ -> 32 - AbiArray _ _ xs -> Vector.sum (Vector.map abiHeadSize xs) + - Vector.sum (Vector.map abiTailSize xs) - AbiBytesDynamic _ -> 32 - AbiArrayDynamic _ _ -> 32 - AbiString _ -> 32 - AbiTuple v -> sum (abiHeadSize <$> v) + - sum (abiTailSize <$> v) + AbiTuple v -> sum (abiHeadSize <$> v) + AbiArray _ _ xs -> sum (abiHeadSize <$> xs) + _ -> error "impossible" putAbiSeq :: Vector AbiValue -> Put putAbiSeq xs = - do snd $ Vector.foldl' f (headSize, pure ()) (Vector.zip xs tailSizes) - Vector.sequence_ (Vector.map putAbiTail xs) + do putHeads headSize $ toList xs + Vector.sequence_ (putAbiTail <$> xs) where headSize = Vector.sum $ Vector.map abiHeadSize xs - tailSizes = Vector.map abiTailSize xs - f (i, m) (x, j) = + putHeads _ [] = pure () + putHeads offset (x:xs') = case abiKind (abiValueType x) of - Static -> (i, m >> putAbi x) - Dynamic -> (i + j, m >> putAbi (AbiUInt 256 (fromIntegral i))) + Static -> do putAbi x + putHeads offset xs' + Dynamic -> do putAbi (AbiUInt 256 (fromIntegral offset)) + putHeads (offset + abiTailSize x) xs' encodeAbiValue :: AbiValue -> BS.ByteString encodeAbiValue = BSLazy.toStrict . runPut . putAbi @@ -353,11 +331,6 @@ putWord32be (abiKeccak (encodeUtf8 s)) putAbi args -abiCalldata :: Text -> Vector AbiValue -> BS.ByteString -abiCalldata s xs = BSLazy.toStrict . runPut $ do - putWord32be (abiKeccak (encodeUtf8 s)) - putAbiSeq xs - parseTypeName :: Vector AbiType -> Text -> Maybe AbiType parseTypeName = P.parseMaybe . typeWithArraySuffix @@ -429,7 +402,7 @@ AbiIntType n -> do a <- genUInt n let AbiUInt _ x = a - pure $ AbiInt n (signedWord x) + pure $ AbiInt n (signedWord (x - 2^(n-1))) AbiAddressType -> (\(AbiUInt _ x) -> AbiAddress (fromIntegral x)) <$> genUInt 20 AbiBoolType -> @@ -453,22 +426,19 @@ genUInt n = AbiUInt n <$> arbitraryIntegralWithMax (2^n-1) instance Arbitrary AbiType where - arbitrary = sized $ \n -> oneof $ -- prevent empty tuples + arbitrary = oneof $ -- doesn't create any tuples [ (AbiUIntType . (* 8)) <$> choose (1, 32) , (AbiIntType . (* 8)) <$> choose (1, 32) , pure AbiAddressType , pure AbiBoolType - , AbiBytesType . getPositive <$> arbitrary + , AbiBytesType <$> choose (1,32) , pure AbiBytesDynamicType , pure AbiStringType , AbiArrayDynamicType <$> scale (`div` 2) arbitrary , AbiArrayType <$> (getPositive <$> arbitrary) <*> scale (`div` 2) arbitrary - ] <> - [AbiTupleType - <$> scale (`div` 2) (Vector.fromList <$> arbitrary) - | n /= 0] + ] instance Arbitrary AbiValue where arbitrary = arbitrary >>= genAbiValue @@ -540,12 +510,28 @@ skipSpaces return a) `sepBy` (char ',')) -decodeStaticArgs :: Buffer -> [SWord 256] +data AbiVals = NoVals | CAbi [AbiValue] | SAbi [SymWord] + +decodeBuffer :: [AbiType] -> Buffer -> AbiVals +decodeBuffer tps (ConcreteBuffer b) + = case runGetOrFail (getAbiSeq (length tps) tps) (BSLazy.fromStrict b) of + Right ("", _, args) -> CAbi . toList $ args + _ -> NoVals +decodeBuffer tps b@(SymbolicBuffer _) + = if containsDynamic tps + then NoVals + else SAbi . decodeStaticArgs $ b + where + isDynamic t = abiKind t == Dynamic + containsDynamic = or . fmap isDynamic + +decodeStaticArgs :: Buffer -> [SymWord] decodeStaticArgs buffer = let bs = case buffer of ConcreteBuffer b -> litBytes b SymbolicBuffer b -> b - in fmap (\i -> fromBytes $ take 32 (drop (i*32) bs)) [0..((length bs) `div` 32 - 1)] + in fmap (\i -> S (FromBytes buffer) $ + fromBytes $ take 32 (drop (i*32) bs)) [0..((length bs) `div` 32 - 1)] -- A modification of 'arbitrarySizedBoundedIntegral' quickcheck library -- which takes the maxbound explicitly rather than relying on a Bounded instance. diff --git a/src/EVM/Concrete.hs b/src/EVM/Concrete.hs --- a/src/EVM/Concrete.hs +++ b/src/EVM/Concrete.hs @@ -12,7 +12,6 @@ import Data.Bits (Bits (..), shiftL, shiftR) import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) -import Data.Semigroup ((<>)) import Data.Word (Word8) import qualified Data.ByteString as BS @@ -106,7 +105,7 @@ | otherwise = g (x * x) ((y - 1) `shiftR` 1) (x * z) createAddress :: Addr -> W256 -> Addr -createAddress a n = num $ keccak $ rlpList [rlpWord160 a, rlpWord256 n] +createAddress a n = num $ keccak $ rlpList [rlpAddrFull a, rlpWord256 n] create2Address :: Addr -> W256 -> ByteString -> Addr create2Address a s b = num $ keccak $ mconcat diff --git a/src/EVM/Dapp.hs b/src/EVM/Dapp.hs --- a/src/EVM/Dapp.hs +++ b/src/EVM/Dapp.hs @@ -18,11 +18,9 @@ import Data.Text (Text, isPrefixOf, pack, unpack) import Data.Text.Encoding (encodeUtf8) import Data.Map (Map, toList) -import Data.Monoid ((<>)) import Data.Maybe (isJust, fromJust) import Data.Word (Word32) -import Control.Applicative ((<$>)) import Control.Arrow ((>>>)) import Control.Lens diff --git a/src/EVM/Debug.hs b/src/EVM/Debug.hs --- a/src/EVM/Debug.hs +++ b/src/EVM/Debug.hs @@ -3,6 +3,7 @@ import EVM (Contract, storage, nonce, balance, bytecode, codehash) import EVM.Solidity (SrcMap, srcMapFile, srcMapOffset, srcMapLength, SourceCache, sourceFiles) import EVM.Types (Addr) +import EVM.Symbolic (len) import Control.Arrow (second) import Control.Lens @@ -28,11 +29,10 @@ prettyContract :: Contract -> Doc prettyContract c = object - [ (text "codesize", int (ByteString.length (c ^. bytecode))) + [ (text "codesize", int (len (c ^. bytecode))) , (text "codehash", text (show (c ^. codehash))) , (text "balance", int (fromIntegral (c ^. balance))) , (text "nonce", int (fromIntegral (c ^. nonce))) - , (text "code", text (show (ByteString.take 16 (c ^. bytecode)))) , (text "storage", text (show (c ^. storage))) ] diff --git a/src/EVM/Dev.hs b/src/EVM/Dev.hs --- a/src/EVM/Dev.hs +++ b/src/EVM/Dev.hs @@ -24,6 +24,7 @@ import qualified Data.Aeson as JSON import Options.Generic import Data.SBV.Trans.Control +import Data.Maybe (fromMaybe) import Control.Monad.State.Strict (execStateT) import qualified Data.Map as Map @@ -156,10 +157,15 @@ getOp :: VM -> Word8 getOp vm = - if BS.length (view (state . code) vm) <= view (state . EVM.pc) vm - then 0 - else fromIntegral $ BS.index (view (state . code) vm) (view (state . EVM.pc) vm) - + let i = vm ^. state . EVM.pc + code' = vm ^. state . code + xs = case code' of + ConcreteBuffer xs' -> ConcreteBuffer (BS.drop i xs') + SymbolicBuffer xs' -> SymbolicBuffer (drop i xs') + in if len xs == 0 then 0 + else case xs of + ConcreteBuffer b -> BS.index b 0 + SymbolicBuffer b -> fromSized $ fromMaybe (error "unexpected symbolic code") (unliteral (b !! 0)) vmtrace :: VM -> VMTrace vmtrace vm = diff --git a/src/EVM/Emacs.hs b/src/EVM/Emacs.hs --- a/src/EVM/Emacs.hs +++ b/src/EVM/Emacs.hs @@ -25,7 +25,6 @@ import EVM.Dapp import EVM.Debug (srcMapCodePos) import EVM.Fetch (Fetcher) -import EVM.Op import EVM.Solidity import EVM.Stepper (Stepper) import EVM.TTY (currentSrcMap) @@ -38,7 +37,6 @@ import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Data.Vector as Vector import qualified EVM.Fetch as Fetch import qualified EVM.Stepper as Stepper @@ -301,7 +299,7 @@ currentFileName == wantedFileName && currentLineNumber == wantedLineNumber -codeByHash :: W256 -> VM -> Maybe ByteString +codeByHash :: W256 -> VM -> Maybe Buffer codeByHash h vm = do let cs = view (env . contracts) vm c <- List.find (\c -> h == (view codehash c)) (Map.elems cs) @@ -311,9 +309,6 @@ allHashes vm = let cs = view (env . contracts) vm in Set.fromList ((view codehash) <$> Map.elems cs) -prettifyCode :: ByteString -> String -prettifyCode b = List.intercalate "\n" (opString <$> (Vector.toList (EVM.mkCodeOps b))) - outputVm :: Console () outputVm = do UiVm s <- get @@ -324,7 +319,6 @@ output $ L [ A "step" , L [A ("vm" :: Text), sexp (view uiVm s)] - , L [A ("newCodes" :: Text), sexp ((fmap prettifyCode) <$> sendCodes)] ] fromMaybe noMap $ do dapp <- view uiVmDapp s @@ -339,7 +333,6 @@ , A (txt (srcMapLength sm)) , A (txt (srcMapJump sm)) ] - , L [A ("newCodes" :: Text), sexp ((fmap prettifyCode) <$> sendCodes)] ] diff --git a/src/EVM/Exec.hs b/src/EVM/Exec.hs --- a/src/EVM/Exec.hs +++ b/src/EVM/Exec.hs @@ -21,7 +21,7 @@ vmForEthrunCreation :: ByteString -> VM vmForEthrunCreation creationCode = (makeVm $ VMOpts - { vmoptContract = initialContract (InitCode creationCode) + { vmoptContract = initialContract (InitCode (ConcreteBuffer creationCode)) , vmoptCalldata = (mempty, 0) , vmoptValue = 0 , vmoptAddress = createAddress ethrunAddress 1 @@ -36,10 +36,11 @@ , vmoptGas = 0xffffffffffffffff , vmoptGaslimit = 0xffffffffffffffff , vmoptMaxCodeSize = 0xffffffff - , vmoptSchedule = FeeSchedule.istanbul + , vmoptSchedule = FeeSchedule.berlin , vmoptChainId = 1 , vmoptCreate = False , vmoptStorageModel = ConcreteS + , vmoptTxAccessList = mempty }) & set (env . contracts . at ethrunAddress) (Just (initialContract (RuntimeCode mempty))) diff --git a/src/EVM/Facts.hs b/src/EVM/Facts.hs --- a/src/EVM/Facts.hs +++ b/src/EVM/Facts.hs @@ -38,7 +38,7 @@ import EVM (VM, Contract, Cache) import EVM.Symbolic (litWord, forceLit) import EVM (balance, nonce, storage, bytecode, env, contracts, contract, state, cache, fetched) -import EVM.Types (Addr, Word, SymWord) +import EVM.Types (Addr, Word, SymWord, Buffer(..)) import qualified EVM @@ -112,12 +112,21 @@ _ -> Nothing contractFacts :: Addr -> Contract -> [Fact] -contractFacts a x = storageFacts a x ++ - [ BalanceFact a (view balance x) - , NonceFact a (view nonce x) - , CodeFact a (view bytecode x) - ] +contractFacts a x = case view bytecode x of + ConcreteBuffer b -> + storageFacts a x ++ + [ BalanceFact a (view balance x) + , NonceFact a (view nonce x) + , CodeFact a b + ] + SymbolicBuffer b -> + -- here simply ignore storing the bytecode + storageFacts a x ++ + [ BalanceFact a (view balance x) + , NonceFact a (view nonce x) + ] + storageFacts :: Addr -> Contract -> [Fact] storageFacts a x = case view storage x of EVM.Symbolic _ _ -> [] @@ -151,7 +160,7 @@ apply1 vm fact = case fact of CodeFact {..} -> flip execState vm $ do - assign (env . contracts . at addr) (Just (EVM.initialContract (EVM.RuntimeCode blob))) + assign (env . contracts . at addr) (Just (EVM.initialContract (EVM.RuntimeCode (ConcreteBuffer blob)))) when (view (state . contract) vm == addr) $ EVM.loadContract addr StorageFact {..} -> vm & over (env . contracts . ix addr . storage) (EVM.writeStorage (litWord which) (litWord what)) @@ -164,7 +173,7 @@ apply2 vm fact = case fact of CodeFact {..} -> flip execState vm $ do - assign (cache . fetched . at addr) (Just (EVM.initialContract (EVM.RuntimeCode blob))) + assign (cache . fetched . at addr) (Just (EVM.initialContract (EVM.RuntimeCode (ConcreteBuffer blob)))) when (view (state . contract) vm == addr) $ EVM.loadContract addr StorageFact {..} -> vm & over (cache . fetched . ix addr . storage) (EVM.writeStorage (litWord which) (litWord what)) diff --git a/src/EVM/FeeSchedule.hs b/src/EVM/FeeSchedule.hs --- a/src/EVM/FeeSchedule.hs +++ b/src/EVM/FeeSchedule.hs @@ -45,6 +45,11 @@ , g_pairing_base :: n , g_fround :: n , r_block :: n + , g_cold_sload :: n + , g_cold_account_access :: n + , g_warm_storage_read :: n + , g_access_list_address :: n + , g_access_list_storage_key :: n } deriving Show -- For the purposes of this module, we define an EIP as just a fee @@ -115,6 +120,11 @@ , g_pairing_base = 100000 , g_fround = 1 , r_block = 2000000000000000000 + , g_cold_sload = 2100 + , g_cold_account_access = 2600 + , g_warm_storage_read = 100 + , g_access_list_address = 2400 + , g_access_list_storage_key = 1900 } metropolis :: Num n => FeeSchedule n @@ -158,3 +168,18 @@ istanbul :: Num n => FeeSchedule n istanbul = eip1108 . eip1884 . eip2028 . eip2200 $ metropolis + + -- EIP2929: Gas cost increases for state access opcodes + -- +eip2929 :: EIP n +eip2929 fees = fees + { g_sload = 100 + , g_sreset = 5000 - 2100 + , g_call = 2600 + , g_balance = 2600 + , g_extcode = 2600 + , g_extcodehash = 2600 + } + +berlin :: Num n => FeeSchedule n +berlin = eip2929 istanbul diff --git a/src/EVM/Fetch.hs b/src/EVM/Fetch.hs --- a/src/EVM/Fetch.hs +++ b/src/EVM/Fetch.hs @@ -6,7 +6,7 @@ import Prelude hiding (Word) -import EVM.Types (Addr, w256, W256, hexText, Word) +import EVM.Types (Addr, w256, W256, hexText, Word, Buffer(..)) import EVM.Symbolic (litWord) import EVM (IsUnique(..), EVM, Contract, Block, initialContract, nonce, balance, external) import qualified EVM.FeeSchedule as FeeSchedule @@ -104,7 +104,7 @@ number <- readText <$> j ^? key "number" . _String difficulty <- readText <$> j ^? key "difficulty" . _String -- default codesize, default gas limit, default feescedule - return $ EVM.Block coinbase timestamp number difficulty 0xffffffff 0xffffffff FeeSchedule.istanbul + return $ EVM.Block coinbase timestamp number difficulty 0xffffffff 0xffffffff FeeSchedule.berlin fetchWithSession :: Text -> Session -> Value -> IO (Maybe Value) fetchWithSession url sess x = do @@ -123,7 +123,7 @@ theBalance <- MaybeT $ fetch (QueryBalance addr) return $ - initialContract (EVM.RuntimeCode theCode) + initialContract (EVM.RuntimeCode (ConcreteBuffer theCode)) & set nonce (w256 theNonce) & set balance (w256 theBalance) & set external True diff --git a/src/EVM/Flatten.hs b/src/EVM/Flatten.hs --- a/src/EVM/Flatten.hs +++ b/src/EVM/Flatten.hs @@ -10,7 +10,7 @@ -- This module is mostly independent from the rest of Hevm, -- using only the source code metadata support modules. -import EVM.Dapp (DappInfo, dappSources) +import EVM.Dapp (DappInfo, dappSources, regexMatches) import EVM.Solidity (sourceAsts) import EVM.Demand (demand) @@ -35,12 +35,11 @@ import Control.Monad (forM) import Data.ByteString (ByteString) import Data.Foldable (foldl', toList) -import Data.List (sort, nub) +import Data.List (sort, nub, (\\)) import Data.Map (Map, (!), (!?)) import Data.Maybe (mapMaybe, isJust, catMaybes, fromMaybe) -import Data.Monoid ((<>)) import Data.Text (Text, unpack, pack, intercalate) -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Text.Read (readMaybe) import qualified Data.Map as Map @@ -179,6 +178,8 @@ pragma :: Text pragma = maximalPragma (Map.elems (Map.filterWithKey (\k _ -> k `elem` ordered) asts)) + license :: Text + license = joinLicenses (Map.elems (Map.filterWithKey (\k _ -> k `elem` ordered) asts)) -- Read the source files in order and strip unwanted directives. -- Also add an informative comment with the original source file path. sources <- @@ -191,8 +192,9 @@ (prefixContractAst contractsAndStructsToRename contractStructs - (stripImportsAndPragmas (src, 0) (asts ! path)) - (asts ! path)), "\n" + (stripImportsAndPragmas (stripLicense src) (asts ! path)) + (asts ! path)) + , "\n" ] -- Force all evaluation before any printing happens, to avoid @@ -201,15 +203,22 @@ -- Finally print the whole concatenation. putStrLn $ "// hevm: flattened sources of " <> unpack target + putStrLn (unpack license) putStrLn (unpack pragma) BS.putStr (mconcat sources) +joinLicenses :: [Value] -> Text +joinLicenses asts = + case nub $ mapMaybe (\ast -> getAttribute "license" ast >>= preview _String) asts of + [] -> "" + x -> "// SPDX-License-Identifier: " <> intercalate " AND " x + -- | Construct a new Solidity version pragma for the highest mentioned version -- given a list of source file ASTs. maximalPragma :: [Value] -> Text maximalPragma asts = ( case mapMaybe versions asts of - [] -> error "no Solidity version pragmas in any source files" + [] -> "" -- allow for no pragma xs -> "pragma solidity " <> pack (show (rangeIntersection xs)) @@ -283,6 +292,15 @@ Just t == preview (key "name" . _String) x || Just t == preview (key "nodeType" . _String) x +-- | Removes all lines containing "SPDX-License-Identifier" +stripLicense :: ByteString -> (ByteString, Int) +stripLicense bs = + (encodeUtf8 $ Text.unlines (lines' \\ licenseLines), - sum (((1 +) . Text.length) <$> licenseLines)) + where lines' = Text.lines $ decodeUtf8 bs + licenseLines = filter (regexMatches "SPDX-License-Identifier") lines' + +-- | (bytes, offset) where offset is added or incremeneted as text is +-- inserted or removed from the source file stripImportsAndPragmas :: (ByteString, Int) -> Value -> (ByteString, Int) stripImportsAndPragmas bso ast = stripAstNodes bso ast p where diff --git a/src/EVM/Format.hs b/src/EVM/Format.hs --- a/src/EVM/Format.hs +++ b/src/EVM/Format.hs @@ -30,7 +30,6 @@ import Data.DoubleWord (signedWord) import Data.Foldable (toList) import Data.Maybe (catMaybes, fromMaybe) -import Data.Monoid ((<>)) import Data.Text (Text, pack, unpack, intercalate) import Data.Text (dropEnd, splitOn) import Data.Text.Encoding (decodeUtf8, decodeUtf8') diff --git a/src/EVM/Op.hs b/src/EVM/Op.hs --- a/src/EVM/Op.hs +++ b/src/EVM/Op.hs @@ -3,7 +3,7 @@ , opString ) where -import EVM.Types (W256) +import EVM.Types (SymWord) import Data.Word (Word8) import Numeric (showHex) @@ -83,7 +83,7 @@ | OpDup !Word8 | OpSwap !Word8 | OpLog !Word8 - | OpPush !W256 + | OpPush !SymWord | OpUnknown Word8 deriving (Show, Eq) diff --git a/src/EVM/Patricia.hs b/src/EVM/Patricia.hs --- a/src/EVM/Patricia.hs +++ b/src/EVM/Patricia.hs @@ -12,7 +12,6 @@ import Data.ByteString (ByteString) import Data.Foldable (toList) import Data.List (stripPrefix) -import Data.Monoid ((<>)) import Data.Sequence (Seq) import qualified Data.ByteString as BS diff --git a/src/EVM/RLP.hs b/src/EVM/RLP.hs --- a/src/EVM/RLP.hs +++ b/src/EVM/RLP.hs @@ -66,6 +66,10 @@ octets x = BS.pack $ dropWhile (== 0) [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..31]] +octetsFull :: Int -> W256 -> ByteString +octetsFull n x = + BS.pack $ [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..n]] + octets160 :: Addr -> ByteString octets160 x = BS.pack $ dropWhile (== 0) [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..19]] @@ -73,6 +77,12 @@ rlpWord256 :: W256 -> RLP rlpWord256 0 = BS mempty rlpWord256 n = BS $ octets n + +rlpWordFull :: W256 -> RLP +rlpWordFull = BS . octetsFull 31 + +rlpAddrFull :: Addr -> RLP +rlpAddrFull = BS . octetsFull 19 . num rlpWord160 :: Addr -> RLP rlpWord160 0 = BS mempty diff --git a/src/EVM/Solidity.hs b/src/EVM/Solidity.hs --- a/src/EVM/Solidity.hs +++ b/src/EVM/Solidity.hs @@ -1,4 +1,5 @@ {-# Language DeriveAnyClass #-} +{-# Language DataKinds #-} {-# Language StrictData #-} {-# Language TemplateHaskell #-} {-# Language OverloadedStrings #-} @@ -40,6 +41,7 @@ , sourceLines , sourceAsts , stripBytecodeMetadata + , stripBytecodeMetadataSym , signature , solc , Language(..) @@ -52,6 +54,7 @@ import EVM.ABI import EVM.Types +import Data.SBV import Control.Applicative import Control.Monad @@ -87,7 +90,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Text as Text import qualified Data.Vector as Vector -import Data.List (sort) +import Data.List (sort, isPrefixOf, isInfixOf, elemIndex, tails, findIndex) data StorageItem = StorageItem { _type :: SlotType, @@ -510,7 +513,7 @@ stdjson :: Language -> Text -> Text stdjson lang src = decodeUtf8 $ toStrict $ encode $ StandardJSON lang src --- When doing CREATE and passing constructor arguments, Solidity loads +-- | When doing CREATE and passing constructor arguments, Solidity loads -- the argument data via the creation bytecode, since there is no "calldata" -- for CREATE. -- @@ -528,6 +531,22 @@ case find ((/= mempty) . snd) stripCandidates of Nothing -> bs Just (b, _) -> b + +stripBytecodeMetadataSym :: [SWord 8] -> [SWord 8] +stripBytecodeMetadataSym b = + let + concretes :: [Maybe Word8] + concretes = (fmap fromSized) <$> unliteral <$> b + bzzrs :: [[Maybe Word8]] + bzzrs = fmap (Just) <$> BS.unpack <$> knownBzzrPrefixes + candidates = (flip Data.List.isInfixOf concretes) <$> bzzrs + in case elemIndex True candidates of + Nothing -> b + Just i -> let Just ind = infixIndex (bzzrs !! i) concretes + in take ind b + +infixIndex :: (Eq a) => [a] -> [a] -> Maybe Int +infixIndex needle haystack = findIndex (isPrefixOf needle) (tails haystack) knownBzzrPrefixes :: [ByteString] knownBzzrPrefixes = [ diff --git a/src/EVM/SymExec.hs b/src/EVM/SymExec.hs --- a/src/EVM/SymExec.hs +++ b/src/EVM/SymExec.hs @@ -116,11 +116,11 @@ ConcreteS -> return $ Concrete mempty c <- SAddr <$> freshVar_ value' <- var "CALLVALUE" <$> freshVar_ - return $ loadSymVM (RuntimeCode x) symstore storagemodel c value' (SymbolicBuffer cd', cdlen) & over constraints ((<>) [cdconstraint]) + return $ loadSymVM (RuntimeCode (ConcreteBuffer x)) symstore storagemodel c value' (SymbolicBuffer cd', cdlen) & over constraints ((<>) [cdconstraint]) loadSymVM :: ContractCode -> Storage -> StorageModel -> SAddr -> SymWord -> (Buffer, SymWord) -> VM loadSymVM x initStore model addr callvalue' calldata' = - (makeVm $ VMOpts + (makeVm $ VMOpts { vmoptContract = contractWithStore x initStore , vmoptCalldata = calldata' , vmoptValue = callvalue' @@ -136,10 +136,11 @@ , vmoptGas = 0xffffffffffffffff , vmoptGaslimit = 0xffffffffffffffff , vmoptMaxCodeSize = 0xffffffff - , vmoptSchedule = FeeSchedule.istanbul + , vmoptSchedule = FeeSchedule.berlin , vmoptChainId = 1 , vmoptCreate = False , vmoptStorageModel = model + , vmoptTxAccessList = mempty }) & set (env . contracts . at (createAddress ethrunAddress 1)) (Just (contractWithStore x initStore)) @@ -343,7 +344,10 @@ -- | Compares two contract runtimes for trace equivalence by running two VMs and comparing the end states. equivalenceCheck :: ByteString -> ByteString -> Maybe Integer -> Maybe (Text, [AbiType]) -> Query (Either ([VM], [VM]) VM) equivalenceCheck bytecodeA bytecodeB maxiter signature' = do - preStateA <- abstractVM signature' [] bytecodeA SymbolicS + let + bytecodeA' = if BS.null bytecodeA then BS.pack [0] else bytecodeA + bytecodeB' = if BS.null bytecodeB then BS.pack [0] else bytecodeB + preStateA <- abstractVM signature' [] bytecodeA' SymbolicS let preself = preStateA ^. state . contract precaller = preStateA ^. state . caller @@ -351,7 +355,7 @@ prestorage = preStateA ^?! env . contracts . ix preself . storage (calldata', cdlen) = view (state . calldata) preStateA pathconds = view constraints preStateA - preStateB = loadSymVM (RuntimeCode bytecodeB) prestorage SymbolicS precaller callvalue' (calldata', cdlen) & set constraints pathconds + preStateB = loadSymVM (RuntimeCode (ConcreteBuffer bytecodeB')) prestorage SymbolicS precaller callvalue' (calldata', cdlen) & set constraints pathconds smtState <- queryState push 1 diff --git a/src/EVM/Symbolic.hs b/src/EVM/Symbolic.hs --- a/src/EVM/Symbolic.hs +++ b/src/EVM/Symbolic.hs @@ -63,12 +63,12 @@ addmod :: SymWord -> SymWord -> SymWord -> SymWord addmod (S a x) (S b y) (S c z) = let to512 :: SWord 256 -> SWord 512 to512 = sFromIntegral - in S (Todo "addmod" [a, b, c]) $ sFromIntegral $ ((to512 x) + (to512 y)) `sMod` (to512 z) + in S (Todo "addmod" [a, b, c]) $ ite (z .== 0) 0 $ sFromIntegral $ ((to512 x) + (to512 y)) `sMod` (to512 z) mulmod :: SymWord -> SymWord -> SymWord -> SymWord mulmod (S a x) (S b y) (S c z) = let to512 :: SWord 256 -> SWord 512 to512 = sFromIntegral - in S (Todo "mulmod" [a, b, c]) $ sFromIntegral $ ((to512 x) * (to512 y)) `sMod` (to512 z) + in S (Todo "mulmod" [a, b, c]) $ ite (z .== 0) 0 $ sFromIntegral $ ((to512 x) * (to512 y)) `sMod` (to512 z) -- | Signed less than slt :: SymWord -> SymWord -> SymWord @@ -202,6 +202,10 @@ readSWord :: Word -> Buffer -> SymWord readSWord i (SymbolicBuffer x) = readSWord' i x readSWord i (ConcreteBuffer x) = num $ Concrete.readMemoryWord i x + +index :: Int -> Buffer -> SWord8 +index x (ConcreteBuffer b) = literal $ BS.index b x +index x (SymbolicBuffer b) = fromSized $ b !! x -- * Uninterpreted functions diff --git a/src/EVM/TTY.hs b/src/EVM/TTY.hs --- a/src/EVM/TTY.hs +++ b/src/EVM/TTY.hs @@ -40,7 +40,6 @@ import Data.ByteString (ByteString) import Data.Maybe (isJust, fromJust, fromMaybe) import Data.Map (Map, insert, lookupLT, singleton, filter) -import Data.Monoid ((<>)) import Data.Text (Text, pack) import Data.Text.Encoding (decodeUtf8) import Data.List (sort, find) @@ -850,19 +849,17 @@ isExecutionHalted _ vm = isJust (view result vm) currentSrcMap :: DappInfo -> VM -> Maybe SrcMap -currentSrcMap dapp vm = +currentSrcMap dapp vm = do + this <- currentContract vm let - Just this = currentContract vm i = (view opIxMap this) SVec.! (view (state . pc) vm) h = view codehash this - in - case preview (dappSolcByHash . ix h) dapp of - Nothing -> - Nothing - Just (Creation, sol) -> - preview (creationSrcmap . ix i) sol - Just (Runtime, sol) -> - preview (runtimeSrcmap . ix i) sol + srcmap <- preview (dappSolcByHash . ix h) dapp + case srcmap of + (Creation, sol) -> + preview (creationSrcmap . ix i) sol + (Runtime, sol) -> + preview (runtimeSrcmap . ix i) sol drawStackPane :: UiVmState -> UiWidget drawStackPane ui = @@ -911,7 +908,7 @@ else withDefAttr boldAttr (opWidget x)) False (move $ list BytecodePane - (view codeOps (fromJust (currentContract vm))) + (maybe mempty (view codeOps) (currentContract vm)) 1) diff --git a/src/EVM/Transaction.hs b/src/EVM/Transaction.hs --- a/src/EVM/Transaction.hs +++ b/src/EVM/Transaction.hs @@ -15,7 +15,8 @@ import Data.Aeson (FromJSON (..)) import Data.ByteString (ByteString) -import Data.Map (Map) +import Data.Map (Map, keys) +import Data.Set (fromList) import Data.Maybe (fromMaybe, isNothing, isJust) import qualified Data.Aeson as JSON @@ -23,8 +24,17 @@ import qualified Data.ByteString as BS import qualified Data.Map as Map -data Transaction = Transaction - { txData :: ByteString, +data AccessListEntry = AccessListEntry { + accessAddress :: Addr, + accessStorageKeys :: [W256] +} deriving Show + +data TxType = LegacyTransaction + | AccessListTransaction + deriving (Show, Eq) + +data Transaction = Transaction { + txData :: ByteString, txGasLimit :: W256, txGasPrice :: W256, txNonce :: W256, @@ -32,29 +42,45 @@ txS :: W256, txToAddr :: Maybe Addr, txV :: W256, - txValue :: W256 - } deriving Show + txValue :: W256, + txType :: TxType, + txAccessList :: [AccessListEntry] +} deriving Show +-- utility function for getting a more useful representation of accesslistentries +-- duplicates only matter for gas computation +-- ugly! could use a review.... +txAccessMap :: Transaction -> Map Addr [W256] +txAccessMap tx = ((Map.fromListWith (++)) . makeTups) $ txAccessList tx + where makeTups = map (\ale -> (accessAddress ale, accessStorageKeys ale)) + ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr -ecrec e v r s = (num . word) <$> EVM.Precompiled.execute 1 input 32 +ecrec v r s e = num . word <$> EVM.Precompiled.execute 1 input 32 where input = BS.concat (word256Bytes <$> [e, v, r, s]) sender :: Int -> Transaction -> Maybe Addr -sender chainId tx = ecrec hash v' (txR tx) (txS tx) - where hash = keccak $ signingData chainId tx +sender chainId tx = ecrec v' (txR tx) (txS tx) hash + where hash = keccak (signingData chainId tx) v = txV tx v' = if v == 27 || v == 28 then v - else 28 - mod v 2 + else 27 + v signingData :: Int -> Transaction -> ByteString signingData chainId tx = - if v == (chainId * 2 + 35) || v == (chainId * 2 + 36) - then eip155Data - else normalData + case txType tx of + LegacyTransaction -> if v == (chainId * 2 + 35) || v == (chainId * 2 + 36) + then eip155Data + else normalData + AccessListTransaction -> eip2930Data where v = fromIntegral (txV tx) to' = case txToAddr tx of Just a -> BS $ word160Bytes a Nothing -> BS mempty + accessList = txAccessList tx + rlpAccessList = EVM.RLP.List $ map (\accessEntry -> + EVM.RLP.List [BS $ word160Bytes (accessAddress accessEntry), + EVM.RLP.List $ map rlpWordFull $ accessStorageKeys accessEntry] + ) accessList normalData = rlpList [rlpWord256 (txNonce tx), rlpWord256 (txGasPrice tx), rlpWord256 (txGasLimit tx), @@ -70,7 +96,24 @@ rlpWord256 (fromIntegral chainId), rlpWord256 0x0, rlpWord256 0x0] + eip2930Data = cons 0x01 $ rlpList [ + rlpWord256 (fromIntegral chainId), + rlpWord256 (txNonce tx), + rlpWord256 (txGasPrice tx), + rlpWord256 (txGasLimit tx), + to', + rlpWord256 (txValue tx), + BS (txData tx), + rlpAccessList] +accessListPrice :: FeeSchedule Integer -> [AccessListEntry] -> Integer +accessListPrice fs al = + sum (map + (\ale -> + g_access_list_address fs + + (g_access_list_storage_key fs * (toInteger . length) (accessStorageKeys ale))) + al) + txGasCost :: FeeSchedule Integer -> Transaction -> Integer txGasCost fs tx = let calldata = txData tx @@ -78,10 +121,21 @@ nonZeroBytes = BS.length calldata - zeroBytes baseCost = g_transaction fs + if isNothing (txToAddr tx) then g_txcreate fs else 0 + + (accessListPrice fs $ txAccessList tx) zeroCost = g_txdatazero fs nonZeroCost = g_txdatanonzero fs in baseCost + zeroCost * (fromIntegral zeroBytes) + nonZeroCost * (fromIntegral nonZeroBytes) +instance FromJSON AccessListEntry where + parseJSON (JSON.Object val) = do + accessAddress_ <- addrField val "address" + --storageKeys <- (val JSON..: "storageKeys") + --accessStorageKeys_ <- JSON.listParser (JSON.withText "W256" (return . readNull 0 . Text.unpack)) storageKeys + accessStorageKeys_ <- (val JSON..: "storageKeys") >>= parseJSONList + return $ AccessListEntry accessAddress_ accessStorageKeys_ + parseJSON invalid = + JSON.typeMismatch "AccessListEntry" invalid + instance FromJSON Transaction where parseJSON (JSON.Object val) = do tdata <- dataField val "data" @@ -93,7 +147,15 @@ toAddr <- addrFieldMaybe val "to" v <- wordField val "v" value <- wordField val "value" - return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value + txType <- fmap read <$> (val JSON..:? "type") + --let legacyTxn = Transaction tdata gasLimit gasPrice nonce r s toAddr v value + case txType of + Just 0x00 -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value LegacyTransaction [] + Just 0x01 -> do + accessListEntries <- (val JSON..: "accessList") >>= parseJSONList + return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value AccessListTransaction accessListEntries + Just _ -> fail "unrecognized custom transaction type" + Nothing -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value LegacyTransaction [] parseJSON invalid = JSON.typeMismatch "Transaction" invalid @@ -140,11 +202,6 @@ else touchAccount toAddr) $ preState - touched = if creation - then [origin] - else [origin, toAddr] - in vm & EVM.env . EVM.contracts .~ initState & EVM.tx . EVM.txReversion .~ preState - & EVM.tx . EVM.substate . EVM.touchedAccounts .~ touched diff --git a/src/EVM/Types.hs b/src/EVM/Types.hs --- a/src/EVM/Types.hs +++ b/src/EVM/Types.hs @@ -9,17 +9,11 @@ import Prelude hiding (Word, LT, GT) -import Data.Aeson (FromJSON (..), (.:)) - -#if MIN_VERSION_aeson(1, 0, 0) import Data.Aeson (FromJSONKey (..), FromJSONKeyFunction (..)) import Data.Aeson -#endif - import Crypto.Hash import Data.SBV hiding (Word) import Data.Kind -import Data.Monoid ((<>)) import Data.Bifunctor (first) import Data.Char import Data.List (intercalate) @@ -33,7 +27,6 @@ import Data.DoubleWord import Data.DoubleWord.TH import Data.Maybe (fromMaybe) -import Data.Word (Word8) import Numeric (readHex, showHex) import Options.Generic import Control.Arrow ((>>>)) @@ -371,7 +364,7 @@ showsPrec _ addr next = let hex = showHex addr next str = replicate (40 - length hex) '0' ++ hex - in "0x" ++ toChecksumAddress str + in "0x" ++ toChecksumAddress str ++ drop 40 str instance Show SAddr where show (SAddr a) = case unliteral a of diff --git a/src/EVM/UnitTest.hs b/src/EVM/UnitTest.hs --- a/src/EVM/UnitTest.hs +++ b/src/EVM/UnitTest.hs @@ -45,10 +45,8 @@ import Data.Foldable (toList) import Data.Map (Map) import Data.Maybe (fromMaybe, catMaybes, fromJust, isJust, fromMaybe, mapMaybe) -import Data.Monoid ((<>)) import Data.Text (isPrefixOf, stripSuffix, intercalate, Text, pack, unpack) import Data.Text.Encoding (encodeUtf8) -import Data.Word (Word32) import System.Environment (lookupEnv) import System.IO (hFlush, stdout) @@ -763,7 +761,7 @@ let TestVMParams {..} = testParams vm = makeVm $ VMOpts - { vmoptContract = initialContract (InitCode (view creationCode theContract)) + { vmoptContract = initialContract (InitCode (ConcreteBuffer (view creationCode theContract))) , vmoptCalldata = (mempty, 0) , vmoptValue = 0 , vmoptAddress = testAddress @@ -778,10 +776,11 @@ , vmoptGasprice = testGasprice , vmoptMaxCodeSize = testMaxCodeSize , vmoptDifficulty = testDifficulty - , vmoptSchedule = FeeSchedule.istanbul + , vmoptSchedule = FeeSchedule.berlin , vmoptChainId = testChainId , vmoptCreate = True , vmoptStorageModel = ConcreteS -- TODO: support RPC + , vmoptTxAccessList = mempty -- TODO: support unit test access lists??? } creator = initialContract (RuntimeCode mempty) diff --git a/src/EVM/VMTest.hs b/src/EVM/VMTest.hs --- a/src/EVM/VMTest.hs +++ b/src/EVM/VMTest.hs @@ -3,6 +3,7 @@ module EVM.VMTest ( Case + , BlockchainCase #if MIN_VERSION_aeson(1, 0, 0) , parseBCSuite #endif @@ -27,6 +28,8 @@ import Control.Lens import Control.Monad +import GHC.Stack + import Data.Aeson ((.:), FromJSON (..)) import Data.Foldable (fold) import Data.Map (Map) @@ -103,10 +106,10 @@ printContracts actual return okState -checkExpectation :: Bool -> Case -> EVM.VM -> IO Bool +checkExpectation :: HasCallStack => Bool -> Case -> EVM.VM -> IO Bool checkExpectation diff x vm = do let expectation = testExpectation x - let (okState, b2, b3, b4, b5) = checkExpectedContracts vm $ expectation + (okState, b2, b3, b4, b5) = checkExpectedContracts vm $ expectation unless okState $ void $ checkStateFail diff x vm (okState, b2, b3, b4, b5) return okState @@ -118,9 +121,17 @@ padNewAccounts cs'' ks = (fold [Map.insertWith (\_ x -> x) k nullAccount | k <- ks]) cs'' padded_cs' = padNewAccounts cs' (Map.keys cs) padded_cs = padNewAccounts cs (Map.keys cs') - in padded_cs == padded_cs' + in and $ zipWith (===) (Map.elems padded_cs) (Map.elems padded_cs') -checkExpectedContracts :: EVM.VM -> Map Addr EVM.Contract -> (Bool, Bool, Bool, Bool, Bool) +(===) :: EVM.Contract -> EVM.Contract -> Bool +a === b = codeEqual && storageEqual && (view balance a == view balance b) && (view nonce a == view nonce b) + where + storageEqual = view storage a == view storage b + codeEqual = case (view contractcode a, view contractcode b) of + (EVM.RuntimeCode (ConcreteBuffer a'), EVM.RuntimeCode (ConcreteBuffer b')) -> a' == b' + _ -> error "unexpected code" + +checkExpectedContracts :: HasCallStack => EVM.VM -> Map Addr EVM.Contract -> (Bool, Bool, Bool, Bool, Bool) checkExpectedContracts vm expected = let cs = vm ^. EVM.env . EVM.contracts . to (fmap (clearZeroStorage.clearOrigStorage)) expectedCs = clearOrigStorage <$> expected @@ -156,7 +167,7 @@ instance FromJSON EVM.Contract where parseJSON (JSON.Object v) = do - code <- (EVM.RuntimeCode <$> (hexText <$> v .: "code")) + code <- (EVM.RuntimeCode . ConcreteBuffer <$> (hexText <$> v .: "code")) storage' <- Map.mapKeys w256 <$> v .: "storage" balance' <- v .: "balance" nonce' <- v .: "nonce" @@ -211,7 +222,7 @@ filteredCases = Map.filter keepError allCases (erroredCases, parsedCases) = splitEithers filteredCases in if Map.size erroredCases > 0 - then Left ("errored case: " ++ (show $ (Map.elems erroredCases) !! 0)) + then Left ("errored case: " ++ (show erroredCases)) else if Map.size parsedCases == 0 then Left "No cases to check." else Right parsedCases @@ -237,7 +248,7 @@ fromBlockchainCase :: BlockchainCase -> Either BlockchainError Case fromBlockchainCase (BlockchainCase blocks preState postState network) = case (blocks, network) of - ([block], "Istanbul") -> case blockTxs block of + ([block], "Berlin") -> case blockTxs block of [tx] -> fromBlockchainCase' block tx preState postState [] -> Left NoTxs _ -> Left TooManyTxs @@ -248,8 +259,8 @@ -> Map Addr EVM.Contract -> Map Addr EVM.Contract -> Either BlockchainError Case fromBlockchainCase' block tx preState postState = - let isCreate = isNothing (txToAddr tx) - in case (sender 1 tx, checkTx tx preState) of + let isCreate = isNothing (txToAddr tx) in + case (sender 1 tx, checkTx tx preState) of (Nothing, _) -> Left SignatureUnverified (_, Nothing) -> Left (if isCreate then FailedCreate else InvalidTx) (Just origin, Just checkState) -> Right $ Case @@ -273,16 +284,17 @@ , vmoptChainId = 1 , vmoptCreate = isCreate , vmoptStorageModel = EVM.ConcreteS + , vmoptTxAccessList = txAccessMap tx }) checkState postState where toAddr = fromMaybe (EVM.createAddress origin senderNonce) (txToAddr tx) senderNonce = EVM.wordValue $ view (accountAt origin . nonce) preState - feeSchedule = EVM.FeeSchedule.istanbul + feeSchedule = EVM.FeeSchedule.berlin toCode = Map.lookup toAddr preState theCode = if isCreate - then EVM.InitCode (txData tx) + then EVM.InitCode (ConcreteBuffer (txData tx)) else maybe (EVM.RuntimeCode mempty) (view contractcode) toCode cd = if isCreate then (mempty, 0) @@ -310,7 +322,7 @@ toAddr = fromMaybe (EVM.createAddress origin senderNonce) (txToAddr tx) prevCode = view (accountAt toAddr . contractcode) prestate prevNonce = view (accountAt toAddr . nonce) prestate - if isCreate && ((prevCode /= EVM.RuntimeCode mempty) || (prevNonce /= 0)) + if isCreate && ((case prevCode of {EVM.RuntimeCode b -> len b /= 0; _ -> True}) || (prevNonce /= 0)) then mzero else return $ prestate diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -1,4 +1,5 @@ {-# Language OverloadedStrings #-} +{-# Language ViewPatterns #-} {-# Language ScopedTypeVariables #-} {-# Language LambdaCase #-} {-# Language QuasiQuotes #-} @@ -7,6 +8,9 @@ {-# Language GeneralizedNewtypeDeriving #-} {-# Language DataKinds #-} {-# Language StandaloneDeriving #-} + +module Main where + import Data.Text (Text) import Data.ByteString (ByteString) @@ -14,34 +18,28 @@ import qualified Data.Text as Text import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BS (fromStrict) +import qualified Data.ByteString.Lazy as BS (fromStrict, toStrict) import qualified Data.ByteString.Base16 as Hex import Test.Tasty -import Test.Tasty.QuickCheck-- hiding (forAll) +import Test.Tasty.QuickCheck import Test.Tasty.HUnit -import Control.Monad.State.Strict (execState, runState, when) -import Control.Lens hiding (List, pre, (.<), (.>)) +import Control.Monad.State.Strict (execState, runState) +import Control.Lens hiding (List, pre, (.>)) import qualified Data.Vector as Vector import Data.String.Here import Control.Monad.Fail -import Debug.Trace -import Data.SBV.Tools.Overflow import Data.Binary.Put (runPut) import Data.SBV hiding ((===), forAll, sList) import Data.SBV.Control -import Data.SBV.Trans (sList) -import Data.SBV.List (implode) -import qualified Data.SBV.List as SL import qualified Data.Map as Map import Data.Binary.Get (runGetOrFail) import EVM hiding (Query) import EVM.SymExec -import EVM.Symbolic import EVM.ABI import EVM.Exec import qualified EVM.Patricia as Patricia @@ -75,6 +73,28 @@ , testCase "keccak256()" $ SolidityCall "x = uint(keccak256(abi.encodePacked(a)));" [AbiString ""] ===> AbiUInt 256 0xc5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470 + + , testProperty "abi encoding vs. solidity" $ withMaxSuccess 20 $ forAll (arbitrary >>= genAbiValue) $ + \y -> ioProperty $ do + -- traceM ("encoding: " ++ (show y) ++ " : " ++ show (abiValueType y)) + Just encoded <- runStatements [i| x = abi.encode(a);|] + [y] AbiBytesDynamicType + let AbiTuple (Vector.toList -> [solidityEncoded]) = decodeAbiValue (AbiTupleType $ Vector.fromList [AbiBytesDynamicType]) (BS.fromStrict encoded) + let hevmEncoded = encodeAbiValue (AbiTuple $ Vector.fromList [y]) + -- traceM ("encoded (solidity): " ++ show solidityEncoded) + -- traceM ("encoded (hevm): " ++ show (AbiBytesDynamic hevmEncoded)) + assertEqual "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmEncoded) + + , testProperty "abi encoding vs. solidity (2 args)" $ withMaxSuccess 20 $ forAll (arbitrary >>= bothM genAbiValue) $ + \(x', y') -> ioProperty $ do + -- traceM ("encoding: " ++ (show x') ++ ", " ++ (show y') ++ " : " ++ show (abiValueType x') ++ ", " ++ show (abiValueType y')) + Just encoded <- runStatements [i| x = abi.encode(a, b);|] + [x', y'] AbiBytesDynamicType + let AbiTuple (Vector.toList -> [solidityEncoded]) = decodeAbiValue (AbiTupleType $ Vector.fromList [AbiBytesDynamicType]) (BS.fromStrict encoded) + let hevmEncoded = encodeAbiValue (AbiTuple $ Vector.fromList [x',y']) + -- traceM ("encoded (solidity): " ++ show solidityEncoded) + -- traceM ("encoded (hevm): " ++ show (AbiBytesDynamic hevmEncoded)) + assertEqual "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmEncoded) ] , testGroup "Precompiled contracts" @@ -506,7 +526,7 @@ let vm = vm0 & set (state . callvalue) 0 & over (env . contracts) - (Map.insert aAddr (initialContract (RuntimeCode a) & + (Map.insert aAddr (initialContract (RuntimeCode $ ConcreteBuffer a) & set EVM.storage (EVM.Symbolic [] store))) verify vm Nothing Nothing (Just checkAssertions) putStrLn $ "found counterexample:" @@ -622,7 +642,7 @@ case runState exec (vmForEthrunCreation x) of (VMSuccess (ConcreteBuffer targetCode), vm1) -> do let target = view (state . contract) vm1 - vm2 = execState (replaceCodeOfSelf (RuntimeCode targetCode)) vm1 + vm2 = execState (replaceCodeOfSelf (RuntimeCode (ConcreteBuffer targetCode))) vm1 return $ snd $ flip runState vm2 (do resetState assign (state . gas) 0xffffffffffffffff -- kludge @@ -638,6 +658,7 @@ singleContract :: Text -> Text -> IO (Maybe ByteString) singleContract x s = solidity x [i| + pragma experimental ABIEncoderV2; contract ${x} { ${s} } |] @@ -672,10 +693,10 @@ (map (abiTypeSolidity . abiValueType) args) <> ")" runFunction [i| - function foo(${params}) public pure returns (${abiTypeSolidity t} x) { + function foo(${params}) public pure returns (${abiTypeSolidity t} ${defaultDataLocation t} x) { ${stmts} } - |] (abiCalldata s (Vector.fromList args)) + |] (abiMethod s (AbiTuple $ Vector.fromList args)) getStaticAbiArgs :: VM -> [SWord 256] getStaticAbiArgs vm = @@ -683,7 +704,8 @@ bs = case cd of ConcreteBuffer bs' -> ConcreteBuffer $ BS.drop 4 bs' SymbolicBuffer bs' -> SymbolicBuffer $ drop 4 bs' - in decodeStaticArgs bs + args = decodeStaticArgs bs + in fmap (\(S _ v) -> v) args -- includes shaving off 4 byte function sig decodeAbiValues :: [AbiType] -> ByteString -> [AbiValue] @@ -725,3 +747,10 @@ assertEqual (Text.unpack s) (fmap Bytes (Just (encodeAbiValue x))) (fmap Bytes y) + +bothM :: (Monad m) => (a -> m b) -> (a, a) -> m (b, b) +bothM f (a, a') = do + b <- f a + b' <- f a' + return (b, b') +