show trace on UnknownFailure (#1283)

Author: samalws-tob

lib/Echidna/Etheno.hs

@@ -178,7 +178,7 @@ execEthenoTxs et = do
       (_        , AccountCreated _)  -> pure ()
       (Reversion,   _)               -> void $ put vm
       (HandleEffect (Query q), _)    -> crashWithQueryError q et
-      (VMFailure x, _)               -> vmExcept x >> M.fail "impossible"
+      (VMFailure x, _)               -> vmExcept Nothing x >> M.fail "impossible"
       (VMSuccess (ConcreteBuf bc),
        ContractCreated _ ca _ _ _ _) -> do
         #env % #contracts % at (LitAddr ca) % _Just % #code .= InitCode mempty mempty

lib/Echidna/Exec.hs

@@ -24,9 +24,10 @@ import System.Process (readProcessWithExitCode)
 
 import EVM (bytecode, replaceCodeOfSelf, loadContract, exec1, vmOpIx)
 import EVM.ABI
+import EVM.Dapp (DappInfo)
 import EVM.Exec (exec, vmForEthrunCreation)
 import EVM.Fetch qualified
-import EVM.Format (hexText)
+import EVM.Format (hexText, showTraceTree)
 import EVM.Types hiding (Env, Gas)
 
 import Echidna.Events (emptyEvents)
@@ -70,9 +71,12 @@ pattern Illegal :: VMResult Concrete s
 pattern Illegal <- VMFailure (classifyError -> IllegalE)
 
 -- | Given an execution error, throw the appropriate exception.
-vmExcept :: MonadThrow m => EvmError -> m ()
-vmExcept e = throwM $
-  case VMFailure e of {Illegal -> IllegalExec e; _ -> UnknownFailure e}
+-- Also optionally takes a DappInfo and VM, which are used to show the stack trace.
+vmExcept :: MonadThrow m => Maybe (DappInfo, VM Concrete RealWorld) -> EvmError -> m ()
+vmExcept traceInfo e =
+  let trace = uncurry showTraceTree <$> traceInfo
+  in throwM $
+    case VMFailure e of {Illegal -> IllegalExec e; _ -> UnknownFailure e trace}
 
 execTxWith
   :: (MonadIO m, MonadState (VM Concrete RealWorld) m, MonadReader Env m, MonadThrow m)
@@ -201,7 +205,10 @@ execTxWith executeTx tx = do
       #state % #callvalue .= callvalueBeforeVMReset
       #traces .= tracesBeforeVMReset
       #state % #codeContract .= codeContractBeforeVMReset
-    (VMFailure x, _) -> vmExcept x
+    (VMFailure x, _) -> do
+      dapp <- asks (.dapp)
+      vm <- get
+      vmExcept (Just (dapp, vm)) x
     (VMSuccess (ConcreteBuf bytecode'), SolCreate _) -> do
       -- Handle contract creation.
       #env % #contracts % at (LitAddr tx.dst) % _Just % #code .= InitCode mempty mempty

lib/Echidna/Types.hs

@@ -3,22 +3,25 @@ module Echidna.Types where
 import Control.Exception (Exception)
 import Control.Monad.State.Strict (MonadState, get, put, MonadIO(liftIO), runStateT)
 import Control.Monad.ST (RealWorld, stToIO)
+import Data.Text (Text, unpack)
 import Data.Word (Word64)
 import EVM (initialContract)
 import EVM.Types
 
 -- | We throw this when our execution fails due to something other than reversion.
-data ExecException = IllegalExec EvmError | UnknownFailure EvmError
+-- The `Maybe Text` on `UnknownFailure` is an optional stack trace.
+data ExecException = IllegalExec EvmError | UnknownFailure EvmError (Maybe Text)
 
 instance Show ExecException where
   show = \case
     IllegalExec e -> "VM attempted an illegal operation: " ++ show e
-    UnknownFailure (MaxCodeSizeExceeded limit actual) ->
+    UnknownFailure (MaxCodeSizeExceeded limit actual) _ ->
       "Max code size exceeded. " ++ codeSizeErrorDetails limit actual
-    UnknownFailure (MaxInitCodeSizeExceeded limit actual) ->
+    UnknownFailure (MaxInitCodeSizeExceeded limit actual) _ ->
       "Max init code size exceeded. " ++ codeSizeErrorDetails limit actual
-    UnknownFailure e -> "VM failed for unhandled reason, " ++ show e
+    UnknownFailure e trace -> "VM failed for unhandled reason, " ++ show e
       ++ ". This shouldn't happen. Please file a ticket with this error message and steps to reproduce!"
+      ++ maybe "" ((" Stack trace:\n" ++) . unpack) trace
     where
       codeSizeErrorDetails limit actual =
         "Configured limit: " ++ show limit ++ ", actual: " ++ show actual