hevm 0.44.1 → 0.46.0

raw patch · 29 files changed

+704/−339 lines, 29 filesdep ~cryptonitedep ~sbvPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: cryptonite, sbv

API changes (from Hackage documentation)

Files

• CHANGELOG.md +33/−1
• hevm-cli/hevm-cli.hs +11/−8
• hevm.cabal +3/−3
• run-blockchain-tests +22/−8
• src/EVM.hs +305/−146
• src/EVM/ABI.hs +39/−53
• src/EVM/Concrete.hs +1/−2
• src/EVM/Dapp.hs +0/−2
• src/EVM/Debug.hs +2/−2
• src/EVM/Dev.hs +10/−4
• src/EVM/Emacs.hs +1/−8
• src/EVM/Exec.hs +3/−2
• src/EVM/Facts.hs +17/−8
• src/EVM/FeeSchedule.hs +25/−0
• src/EVM/Fetch.hs +3/−3
• src/EVM/Flatten.hs +25/−7
• src/EVM/Format.hs +0/−1
• src/EVM/Op.hs +2/−2
• src/EVM/Patricia.hs +0/−1
• src/EVM/RLP.hs +10/−0
• src/EVM/Solidity.hs +21/−2
• src/EVM/SymExec.hs +9/−5
• src/EVM/Symbolic.hs +6/−2
• src/EVM/TTY.hs +9/−12
• src/EVM/Transaction.hs +75/−18
• src/EVM/Types.hs +1/−8
• src/EVM/UnitTest.hs +3/−4
• src/EVM/VMTest.hs +24/−12
• test/test.hs +44/−15

@@ -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 

@@ -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

@@ -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,

@@ -46,7 +46,7 @@ <h1>hevm consensus test report</h1> <p>$(date +%Y-%m-%d)</p> <p>$(echo "$npass passed, $nbal bad-balance, $nnon bad-nonce, $nstr bad-storage, $nfail failed, $nskip skipped, $ntime timeout")</p>-(Test suite: <span class=GeneralStateTests</span>GeneralStateTests</span> for Istanbul)+(Test suite: <span class=GeneralStateTests</span>GeneralStateTests</span> for Berlin) </header> <h2>Failed tests</h2> <table id=failed>@@ -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 } | {

@@ -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

@@ -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.

@@ -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

@@ -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 

@@ -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)))     ] 

@@ -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 =

@@ -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)]         ]  

@@ -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))) 

@@ -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))

@@ -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+  -- <https://github.com/ethereum/EIPs/blob/master/EIPS/eip-2929.md>+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

@@ -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

@@ -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

@@ -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')

@@ -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) 

@@ -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

@@ -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

@@ -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 = [

@@ -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

@@ -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 

@@ -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)  

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -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')+