Simplifyexec (dapphub#418)

MrChico · web-flow · commit 141eb25a4658 · 2020-06-26T22:19:09.000+02:00
* hevm: Remove ExecMode, always choosing with ExecuteAsBlockchainTest
omitting --code simply creates an empty contract
useful in combination with --state flag

* hevm update changelog
diff --git a/src/hevm/CHANGELOG.md b/src/hevm/CHANGELOG.md
@@ -3,6 +3,8 @@
 ## 0.39 - unreleased
  - Exposes abi encoding to cli
  - Added cheat code `hevm.store(address a, bytes32 location, bytes32 value)`
+ - Removes `ExecMode`, always running as `ExecuteAsBlockchainTest`. This means that `hevm exec` now finalizes transactions as well.
+ - `--code` is now entirely optional. Not supplying it returns an empty contract, or whatever is stored in `--state`.
 
 ## 0.38 - 2020-04-23
  - Exposes metadata stripping of bytecode to the cli: `hevm strip-metadata --code X`. [357](https://github.com/dapphub/dapptools/pull/357).
diff --git a/src/hevm/hevm-cli/hevm-cli.hs b/src/hevm/hevm-cli/hevm-cli.hs
@@ -24,7 +24,6 @@ import Text.ParserCombinators.ReadP
 import qualified EVM.VMTest as VMTest
 #endif
 
-import EVM (ExecMode(..))
 import EVM.Concrete (createAddress, w256)
 import EVM.Debug
 import EVM.Exec
@@ -132,13 +131,6 @@ data Command w
       , diff    :: w ::: Bool      <?> "Print expected vs. actual state on failure"
       , timeout :: w ::: Maybe Int <?> "Execution timeout (default: 10 sec.)"
       }
-  | VmTest -- Run an Ethereum VMTest
-      { file    :: w ::: String    <?> "Path to .json test file"
-      , test    :: w ::: [String]  <?> "Test case filter - only run specified test method(s)"
-      , debug   :: w ::: Bool      <?> "Run interactively"
-      , diff    :: w ::: Bool      <?> "Print expected vs. actual state on failure"
-      , timeout :: w ::: Maybe Int <?> "Execution timeout (default: 10 sec.)"
-      }
   | Compliance -- Run Ethereum Blockhain or VMTest compliance report
       { tests   :: w ::: String       <?> "Path to Ethereum Tests directory"
       , group   :: w ::: Maybe String <?> "Report group to run: VM or Blockchain (default: Blockchain)"
@@ -228,10 +220,8 @@ main = do
       launchExec cmd
     Abiencode {} ->
       print . ByteStringS $ abiencode (abi cmd) (arg cmd)
-    VmTest {} ->
-      launchTest ExecuteAsVMTest cmd
     BcTest {} ->
-      launchTest ExecuteAsBlockchainTest cmd
+      launchTest cmd
     DappTest {} ->
       withCurrentDirectory root $ do
         testFile <- findJsonFile (jsonFile cmd)
@@ -452,23 +442,21 @@ tohexOrText s = case "0x" `Char8.isPrefixOf` encodeUtf8 s of
 
 vmFromCommand :: Command Options.Unwrapped -> IO EVM.VM
 vmFromCommand cmd = do
-  vm <- case (rpc cmd, address cmd, code cmd) of
-     (Just url, Just addr', _) -> do maybeContract <- EVM.Fetch.fetchContractFrom block' url addr'
-                                     case maybeContract of
-                                       Nothing -> error $ "contract not found: " <> show address' <> "and no --code given"
-                                       Just contract' -> case (code cmd) of
-                                         Nothing -> return (vm1 contract')
-                                         -- if both code and url is given,
-                                         -- fetch the contract and overwrite the code
-                                         Just c -> return $ vm1 (
-                                                      EVM.initialContract (codeType $ hexByteString "--code" $ strip0x c)
-                                                        & set EVM.storage     (view EVM.storage contract')
-                                                        & set EVM.balance     (view EVM.balance contract')
-                                                        & set EVM.nonce       (view EVM.nonce contract')
-                                                        & set EVM.external    (view EVM.external contract'))
-
-     (_, _, Just c)  -> return $ vm1 $ EVM.initialContract $ codeType $ hexByteString "--code" $ strip0x c
-     (_, _, Nothing) -> error $ "must provide at least (rpc + address) or code"
+  vm <- case (rpc cmd, address cmd) of
+     (Just url, Just addr') -> do EVM.Fetch.fetchContractFrom block' url addr' >>= \case
+                                    Nothing -> error $ "contract not found: " <> show address'
+                                    Just contract' -> case code cmd of
+                                      Nothing -> return (vm1 contract')
+                                      -- if both code and url is given,
+                                      -- fetch the contract and overwrite the code
+                                      Just c -> return . vm1 $
+                                                   EVM.initialContract (codeType $ hexByteString "--code" $ strip0x c)
+                                                     & set EVM.storage     (view EVM.storage contract')
+                                                     & set EVM.balance     (view EVM.balance contract')
+                                                     & set EVM.nonce       (view EVM.nonce contract')
+                                                     & set EVM.external    (view EVM.external contract')
+
+     _ -> return . vm1 . EVM.initialContract . codeType $ bytes code ""
      
   return $ vm & EVM.env . EVM.contracts . ix address' . EVM.balance +~ (w256 value')
       where
@@ -505,14 +493,10 @@ vmFromCommand cmd = do
         addr f def = fromMaybe def (f cmd)
         bytes f def = maybe def (hexByteString "bytes" . strip0x) (f cmd)
 
-launchTest :: ExecMode -> Command Options.Unwrapped ->  IO ()
-launchTest execmode cmd = do
+launchTest :: Command Options.Unwrapped ->  IO ()
+launchTest cmd = do
 #if MIN_VERSION_aeson(1, 0, 0)
-  let parser = case execmode of
-        ExecuteAsVMTest -> VMTest.parseSuite
-        ExecuteAsBlockchainTest -> VMTest.parseBCSuite
-        ExecuteNormally -> error "cannot launchTest normally"
-  parsed <- parser <$> LazyByteString.readFile (file cmd)
+  parsed <- VMTest.parseBCSuite <$> LazyByteString.readFile (file cmd)
   case parsed of
      Left "No cases to check." -> putStrLn "no-cases ok"
      Left err -> print err
@@ -522,16 +506,16 @@ launchTest execmode cmd = do
              then id
              else filter (\(x, _) -> elem x (test cmd))
        in
-         mapM_ (runVMTest (diff cmd) execmode (optsMode cmd) (timeout cmd)) $
+         mapM_ (runVMTest (diff cmd) (optsMode cmd) (timeout cmd)) $
            testFilter (Map.toList allTests)
 #else
   putStrLn "Not supported"
 #endif
 
 #if MIN_VERSION_aeson(1, 0, 0)
-runVMTest :: Bool -> ExecMode -> Mode -> Maybe Int -> (String, VMTest.Case) -> IO Bool
-runVMTest diffmode execmode mode timelimit (name, x) = do
-  let vm0 = VMTest.vmForCase execmode x
+runVMTest :: Bool -> Mode -> Maybe Int -> (String, VMTest.Case) -> IO Bool
+runVMTest diffmode mode timelimit (name, x) = do
+  let vm0 = VMTest.vmForCase x
   putStr (name ++ " ")
   hFlush stdout
   result <- do
@@ -545,7 +529,7 @@ runVMTest diffmode execmode mode timelimit (name, x) = do
     waitCatch action
   case result of
     Right (Just vm1) -> do
-      ok <- VMTest.checkExpectation diffmode execmode x vm1
+      ok <- VMTest.checkExpectation diffmode x vm1
       putStrLn (if ok then "ok" else "")
       return ok
     Right Nothing -> do
diff --git a/src/hevm/src/EVM.hs b/src/hevm/src/EVM.hs
@@ -100,7 +100,6 @@ data VM = VM
   , _logs          :: Seq Log
   , _traces        :: Zipper.TreePos Zipper.Empty Trace
   , _cache         :: Cache
-  , _execMode      :: ExecMode
   , _burned        :: Word
   }
 
@@ -118,8 +117,6 @@ data TraceData
   | EntryTrace Text
   | ReturnTrace ByteString FrameContext
 
-data ExecMode = ExecuteNormally | ExecuteAsBlockchainTest | ExecuteAsVMTest
-
 data Query where
   PleaseFetchContract :: Addr         -> (Contract -> EVM ()) -> Query
   PleaseFetchSlot     :: Addr -> Word -> (Word     -> EVM ()) -> Query
@@ -371,7 +368,6 @@ makeVm o = VM
     }
   , _cache = Cache $ Map.fromList
     [(vmoptAddress o, vmoptContract o)]
-  , _execMode = ExecuteNormally
   , _burned = 0
   } where theCode = case _contractcode (vmoptContract o) of
             InitCode b    -> b
@@ -1455,43 +1451,40 @@ finalize = do
       creation <- use (tx . isCreate)
       createe  <- use (state . contract)
       createeExists <- (Map.member createe) <$> use (env . contracts)
-      if (creation && createeExists)
+
+      if creation && createeExists
       then replaceCode createe (RuntimeCode output)
       else noop
 
-  use execMode >>= \case
-    ExecuteAsVMTest ->
-      noop
-    _ -> do
-      -- compute and pay the refund to the caller and the
-      -- corresponding payment to the miner
-      txOrigin     <- use (tx . origin)
-      sumRefunds   <- (sum . (snd <$>)) <$> (use (tx . substate . refunds))
-      miner        <- use (block . coinbase)
-      blockReward  <- r_block <$> (use (block . schedule))
-      gasPrice     <- use (tx . gasprice)
-      gasLimit     <- use (tx . txgaslimit)
-      gasRemaining <- use (state . gas)
-
-      let
-        gasUsed      = gasLimit - gasRemaining
-        cappedRefund = min (quot gasUsed 2) sumRefunds
-        originPay    = (gasRemaining + cappedRefund) * gasPrice
-        minerPay     = gasPrice * (gasUsed - cappedRefund)
-
-      modifying (env . contracts)
-        (Map.adjust (over balance (+ originPay)) txOrigin)
-      modifying (env . contracts)
-        (Map.adjust (over balance (+ minerPay)) miner)
-      touchAccount miner
-
-      -- pay out the block reward, recreating the miner if necessary
-      preuse (env . contracts . ix miner) >>= \case
-        Nothing -> modifying (env . contracts)
-          (Map.insert miner (initialContract (EVM.RuntimeCode mempty)))
-        Just _  -> noop
-      modifying (env . contracts)
-        (Map.adjust (over balance (+ blockReward)) miner)
+  -- compute and pay the refund to the caller and the
+  -- corresponding payment to the miner
+  txOrigin     <- use (tx . origin)
+  sumRefunds   <- (sum . (snd <$>)) <$> (use (tx . substate . refunds))
+  miner        <- use (block . coinbase)
+  blockReward  <- r_block <$> (use (block . schedule))
+  gasPrice     <- use (tx . gasprice)
+  gasLimit     <- use (tx . txgaslimit)
+  gasRemaining <- use (state . gas)
+
+  let
+    gasUsed      = gasLimit - gasRemaining
+    cappedRefund = min (quot gasUsed 2) sumRefunds
+    originPay    = (gasRemaining + cappedRefund) * gasPrice
+    minerPay     = gasPrice * (gasUsed - cappedRefund)
+
+  modifying (env . contracts)
+     (Map.adjust (over balance (+ originPay)) txOrigin)
+  modifying (env . contracts)
+     (Map.adjust (over balance (+ minerPay)) miner)
+  touchAccount miner
+
+  -- pay out the block reward, recreating the miner if necessary
+  preuse (env . contracts . ix miner) >>= \case
+    Nothing -> modifying (env . contracts)
+      (Map.insert miner (initialContract (EVM.RuntimeCode mempty)))
+    Just _  -> noop
+  modifying (env . contracts)
+    (Map.adjust (over balance (+ blockReward)) miner)
 
   -- perform state trie clearing (EIP 161), of selfdestructs
   -- and touched accounts. addresses are cleared if they have
@@ -1653,12 +1646,7 @@ delegateCall this xGas xTo xValue xInOffset xInSize xOutOffset xOutSize xs conti
     assign (state . returndata) mempty
     pushTrace $ ErrorTrace CallDepthLimitReached
     next
-  else case view execMode vm0 of
-    ExecuteAsVMTest -> do
-      assign (state . stack) (1 : xs)
-      next
-    _ ->
-      fetchAccount xTo . const $
+  else fetchAccount xTo . const $
         preuse (env . contracts . ix xTo) >>= \case
           Nothing ->
             vmError (NoSuchContract xTo)
@@ -1734,11 +1722,7 @@ create self this xGas xValue xs newAddr initCode = do
     modifying (env . contracts . ix self . nonce) succ
     next
   else burn xGas $
-    case (view execMode vm0) of
-      ExecuteAsVMTest -> do
-        assign (state . stack) (num newAddr : xs)
-        next
-      _ -> do
+     do
         touchAccount self
         touchAccount newAddr
         let
@@ -1842,11 +1826,7 @@ finishFrame how = do
           FrameReturned output -> VMSuccess output
           FrameReverted output -> VMFailure (Revert output)
           FrameErrored e       -> VMFailure e
-      use execMode >>= \case
-        ExecuteNormally ->
-          noop
-        _ ->
-          finalize
+      finalize
 
     -- Are there some remaining frames?
     nextFrame : remainingFrames -> do
diff --git a/src/hevm/src/EVM/Dev.hs b/src/hevm/src/EVM/Dev.hs
@@ -6,7 +6,6 @@ import EVM.Dapp
 import EVM.Solidity
 import EVM.UnitTest
 
-import qualified EVM
 import qualified EVM.Fetch
 import qualified EVM.TTY
 import qualified EVM.Emacs
@@ -63,12 +62,12 @@ ghciTest root path state =
 
 runBCTest :: (String, VMTest.Case) -> IO Bool
 runBCTest (name, x) = do
-  let vm0 = VMTest.vmForCase EVM.ExecuteAsBlockchainTest x
+  let vm0 = VMTest.vmForCase x
   putStr (name ++ " ")
   result <-
     evaluate $
       execState (VMTest.interpret EVM.Stepper.execFully) vm0
-  ok <- VMTest.checkExpectation False EVM.ExecuteAsBlockchainTest x result
+  ok <- VMTest.checkExpectation False x result
   putStrLn (if ok then "ok" else "")
   return ok
 
diff --git a/src/hevm/src/EVM/VMTest.hs b/src/hevm/src/EVM/VMTest.hs
@@ -147,10 +147,10 @@ checkStateFail diff x expectation vm (okState, okMoney, okNonce, okData, okCode)
                    ++ (show . Map.toList $ EVM._storage v)) actual
   return okState
 
-checkExpectation :: Bool -> EVM.ExecMode -> Case -> EVM.VM -> IO Bool
-checkExpectation diff execmode x vm =
-  case (execmode, testExpectation x, view EVM.result vm) of
-    (EVM.ExecuteAsBlockchainTest, Just expectation, _) -> do
+checkExpectation :: Bool -> Case -> EVM.VM -> IO Bool
+checkExpectation diff x vm =
+  case (testExpectation x, view EVM.result vm) of
+    (Just expectation, _) -> do
       let (okState, b2, b3, b4, b5) =
             checkExpectedContracts vm (expectedContracts expectation)
       _ <- if not okState then
@@ -159,41 +159,17 @@ checkExpectation diff execmode x vm =
            else return True
       return okState
 
-    (_, Just expectation, Just (EVM.VMSuccess output)) -> do
-      let
-        (okState, ok2, ok3, ok4, ok5) =
-          checkExpectedContracts vm (expectedContracts expectation)
-        (s2, b2) = ("bad-output", checkExpectedOut output (expectedOut expectation))
-        (s3, b3) = ("bad-gas", checkExpectedGas vm (expectedGas expectation))
-        ss = map fst (filter (not . snd) [(s2, b2), (s3, b3)])
-      _ <- if not okState then
-               checkStateFail
-                    diff x expectation vm (okState, ok2, ok3, ok4, ok5)
-               else
-                   return True
-      putStr (unwords ss)
-      return (okState && b2 && b3)
-
-    (_, Nothing, Just (EVM.VMSuccess _)) -> do
+    (Nothing, Just (EVM.VMSuccess _)) -> do
       putStr "unexpected-success"
       return False
 
-    (_, Nothing, Just (EVM.VMFailure _)) ->
+    (Nothing, Just (EVM.VMFailure _)) ->
       return True
 
-    (_, Just _, Just (EVM.VMFailure _)) -> do
-      putStr "unexpected-failure"
-      return False
-
-    (_, _, Nothing) -> do
+    (_, Nothing) -> do
       cpprint (view EVM.result vm)
       error "internal error"
 
-checkExpectedOut :: ByteString -> Maybe ByteString -> Bool
-checkExpectedOut output ex = case ex of
-  Nothing       -> True
-  Just expected -> output == expected
-
 -- quotient account state by nullness
 (~=) :: Map Addr EVM.Contract -> Map Addr EVM.Contract -> Bool
 (~=) cs cs' =
@@ -230,13 +206,6 @@ clearNonce = set EVM.nonce 0
 clearCode :: EVM.Contract -> EVM.Contract
 clearCode = set EVM.contractcode (EVM.RuntimeCode mempty)
 
-checkExpectedGas :: EVM.VM -> Maybe W256 -> Bool
-checkExpectedGas vm ex = case ex of
-  Nothing -> True
-  Just expected -> case vm ^. EVM.state . EVM.gas of
-    EVM.C _ x | x == expected -> True
-    _ -> False
-
 #if MIN_VERSION_aeson(1, 0, 0)
 
 instance FromJSON Contract where
@@ -528,15 +497,11 @@ initTx x =
        else id)
     $ checkState
 
-vmForCase :: EVM.ExecMode -> Case -> EVM.VM
-vmForCase mode x =
+vmForCase :: Case -> EVM.VM
+vmForCase x =
   let
     checkState = checkContracts x
-    initState =
-      case mode of
-        EVM.ExecuteAsBlockchainTest -> initTx x
-        EVM.ExecuteAsVMTest         -> checkState
-        EVM.ExecuteNormally         -> error "cannot initialize VM normally"
+    initState = initTx x
     opts = testVmOpts x
     creation = EVM.vmoptCreate opts
     touchedAccounts =
@@ -550,7 +515,6 @@ vmForCase mode x =
     & EVM.tx . EVM.txReversion .~ realizeContracts checkState
     & EVM.tx . EVM.origStorage .~ realizeContracts initState
     & EVM.tx . EVM.substate . EVM.touchedAccounts .~ touchedAccounts
-    & EVM.execMode .~ mode
 
 interpret :: Stepper a -> EVM a
 interpret =
