From ff258b333a2e17cfbe2d622a7c9ef63951c3bd43 Mon Sep 17 00:00:00 2001 From: Artur Cygan Date: Wed, 3 Jan 2024 21:52:19 +0100 Subject: [PATCH] Use trace printing from hevm --- lib/Echidna/Campaign.hs | 5 +-- lib/Echidna/Output/JSON.hs | 11 ++++--- lib/Echidna/Shrink.hs | 3 +- lib/Echidna/Test.hs | 12 +++---- lib/Echidna/Types/Test.hs | 5 ++- lib/Echidna/UI/Report.hs | 64 +++++++++++++++++++------------------- lib/Echidna/UI/Widgets.hs | 47 ++++++++++++++++++---------- package.yaml | 1 + src/test/Tests/Seed.hs | 5 +-- stack.yaml | 1 + 10 files changed, 83 insertions(+), 71 deletions(-) diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index 444487cf4..31768d81b 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -32,7 +32,6 @@ import EVM.Types hiding (Env, Frame(state)) import Echidna.ABI import Echidna.Exec -import Echidna.Events (extractEvents) import Echidna.Mutator.Corpus import Echidna.Shrink (shrinkTest) import Echidna.Symbolic (forceBuf, forceAddr) @@ -373,14 +372,12 @@ updateTest -> EchidnaTest -> m (Maybe EchidnaTest) updateTest vmForShrink (vm, xs) test = do - dappInfo <- asks (.dapp) case test.state of Open -> do (testValue, vm') <- checkETest test vm let - events = extractEvents False dappInfo vm' results = getResultFromVM vm' - test' = updateOpenTest test xs (testValue, events, results) + test' = updateOpenTest test xs (testValue, vm', results) case test'.state of Large _ -> do pushEvent (TestFalsified test') diff --git a/lib/Echidna/Output/JSON.hs b/lib/Echidna/Output/JSON.hs index db0cb13cc..a1abe5a7c 100644 --- a/lib/Echidna/Output/JSON.hs +++ b/lib/Echidna/Output/JSON.hs @@ -13,10 +13,11 @@ import Data.Text.Encoding (decodeUtf8) import Data.Vector.Unboxed qualified as VU import Numeric (showHex) +import EVM.Dapp (DappInfo) import EVM.Types (keccak') import Echidna.ABI (ppAbiValue, GenDict(..)) -import Echidna.Events (Events) +import Echidna.Events (Events, extractEvents) import Echidna.Types (Gas) import Echidna.Types.Campaign (WorkerState(..)) import Echidna.Types.Config (Env(..)) @@ -107,21 +108,21 @@ encodeCampaign env workerStates = do pure $ encode Campaign { _success = True , _error = Nothing - , _tests = mapTest <$> tests + , _tests = mapTest env.dapp <$> tests , seed = worker0.genDict.defSeed , coverage = Map.mapKeys (("0x" ++) . (`showHex` "") . keccak') $ VU.toList <$> frozenCov , gasInfo = Map.toList $ Map.unionsWith max ((.gasInfo) <$> workerStates) } -mapTest :: EchidnaTest -> Test -mapTest test = +mapTest :: DappInfo -> EchidnaTest -> Test +mapTest dappInfo test = let (status, transactions, err) = mapTestState test.state test.reproducer in Test { contract = "" -- TODO add when mapping is available https://github.com/crytic/echidna/issues/415 , name = "name" -- TODO add a proper name here , status = status , _error = err - , events = test.events + , events = maybe [] (extractEvents False dappInfo) test.vm , testType = Property , transactions = transactions } diff --git a/lib/Echidna/Shrink.hs b/lib/Echidna/Shrink.hs index 4e070d79e..9e0574722 100644 --- a/lib/Echidna/Shrink.hs +++ b/lib/Echidna/Shrink.hs @@ -11,7 +11,6 @@ import Data.List qualified as List import EVM.Types (VM) -import Echidna.Events (extractEvents) import Echidna.Exec import Echidna.Transaction import Echidna.Types.Solidity (SolConf(..)) @@ -38,7 +37,7 @@ shrinkTest vm test = do Just (txs, val, vm') -> do Just test { state = Large (i + 1) , reproducer = txs - , events = extractEvents False env.dapp vm' + , vm = Just vm' , result = getResultFromVM vm' , value = val } Nothing -> diff --git a/lib/Echidna/Test.hs b/lib/Echidna/Test.hs index fab706523..bc07d4f91 100644 --- a/lib/Echidna/Test.hs +++ b/lib/Echidna/Test.hs @@ -47,7 +47,7 @@ getResultFromVM vm = Nothing -> error "getResultFromVM failed" createTest :: TestType -> EchidnaTest -createTest m = EchidnaTest Open m v [] Stop [] +createTest m = EchidnaTest Open m v [] Stop Nothing where v = case m of PropertyTest _ _ -> BoolValue True OptimizationTest _ _ -> IntValue minBound @@ -114,17 +114,17 @@ createTests m td ts r ss = case m of updateOpenTest :: EchidnaTest -> [Tx] - -> (TestValue, Events, TxResult) + -> (TestValue, VM RealWorld, TxResult) -> EchidnaTest -updateOpenTest test txs (BoolValue False, es, r) = - test { Test.state = Large 0, reproducer = txs, events = es, result = r } +updateOpenTest test txs (BoolValue False, vm, r) = + test { Test.state = Large 0, reproducer = txs, vm = Just vm, result = r } updateOpenTest test _ (BoolValue True, _, _) = test -updateOpenTest test txs (IntValue v',es,r) = +updateOpenTest test txs (IntValue v', vm, r) = if v' > v then test { reproducer = txs , value = IntValue v' - , events = es + , vm = Just vm , result = r } else test diff --git a/lib/Echidna/Types/Test.hs b/lib/Echidna/Types/Test.hs index ffc83380c..192e8a00e 100644 --- a/lib/Echidna/Types/Test.hs +++ b/lib/Echidna/Types/Test.hs @@ -9,7 +9,6 @@ import Data.Text (Text) import EVM.Dapp (DappInfo) import EVM.Types (Addr, VM) -import Echidna.Events (Events) import Echidna.Types (ExecException) import Echidna.Types.Signature (SolSignature) import Echidna.Types.Tx (Tx, TxResult) @@ -85,8 +84,8 @@ data EchidnaTest = EchidnaTest , value :: TestValue , reproducer :: [Tx] , result :: TxResult - , events :: Events - } deriving (Eq, Show) + , vm :: Maybe (VM RealWorld) + } deriving (Show) isOptimizationTest :: EchidnaTest -> Bool isOptimizationTest EchidnaTest{testType = OptimizationTest _ _} = True diff --git a/lib/Echidna/UI/Report.hs b/lib/Echidna/UI/Report.hs index 7c4b6420c..eb6956848 100644 --- a/lib/Echidna/UI/Report.hs +++ b/lib/Echidna/UI/Report.hs @@ -1,28 +1,29 @@ module Echidna.UI.Report where import Control.Monad.Reader (MonadReader, MonadIO (liftIO), asks) +import Control.Monad.ST (RealWorld) import Data.IORef (readIORef) import Data.List (intercalate, nub, sortOn) import Data.Map (toList) -import Data.Maybe (catMaybes) +import Data.Map qualified as Map +import Data.Maybe (catMaybes, fromJust) import Data.Text (Text, unpack) import Data.Text qualified as T import Data.Time (LocalTime) import Echidna.ABI (GenDict(..), encodeSig) -import Echidna.Events (Events) import Echidna.Pretty (ppTxCall) import Echidna.Types (Gas) import Echidna.Types.Campaign +import Echidna.Types.Config +import Echidna.Types.Corpus (corpusSize) import Echidna.Types.Coverage (scoveragePoints) import Echidna.Types.Test (EchidnaTest(..), TestState(..), TestType(..)) import Echidna.Types.Tx (Tx(..), TxCall(..), TxConf(..)) -import Echidna.Types.Config - -import EVM.Types (W256) -import Echidna.Types.Corpus (corpusSize) import Echidna.Utility (timePrefix) -import qualified Data.Map as Map + +import EVM.Format (showTraceTree) +import EVM.Types (W256, VM) ppLogLine :: (Int, LocalTime, CampaignEvent) -> String ppLogLine (workerId, time, event) = @@ -96,71 +97,70 @@ ppGasOne (func, (gas, txs)) = do pure $ header <> unlines ((" " <>) <$> prettyTxs) -- | Pretty-print the status of a solved test. -ppFail :: MonadReader Env m => Maybe (Int, Int) -> Events -> [Tx] -> m String -ppFail _ _ [] = pure "failed with no transactions made ⁉️ " -ppFail b es xs = do +ppFail :: MonadReader Env m => Maybe (Int, Int) -> VM RealWorld -> [Tx] -> m String +ppFail _ _ [] = pure "failed with no transactions made ⁉️ " +ppFail b vm xs = do let status = case b of Nothing -> "" Just (n,m) -> ", shrinking " <> progress n m prettyTxs <- mapM (ppTx $ length (nub $ (.src) <$> xs) /= 1) xs + dappInfo <- asks (.dapp) pure $ "failed!💥 \n Call sequence" <> status <> ":\n" <> unlines ((" " <>) <$> prettyTxs) <> "\n" - <> ppEvents es - -ppEvents :: Events -> String -ppEvents es = if null es then "" else unlines $ "Event sequence:" : (T.unpack <$> es) + <> "Traces: \n" <> T.unpack (showTraceTree dappInfo vm) -- | Pretty-print the status of a test. -ppTS :: MonadReader Env m => TestState -> Events -> [Tx] -> m String +ppTS :: MonadReader Env m => TestState -> VM RealWorld -> [Tx] -> m String ppTS (Failed e) _ _ = pure $ "could not evaluate ☣\n " <> show e -ppTS Solved es l = ppFail Nothing es l +ppTS Solved vm l = ppFail Nothing vm l ppTS Passed _ _ = pure " passed! 🎉" ppTS Open _ [] = pure "passing" -ppTS Open es r = ppFail Nothing es r -ppTS (Large n) es l = do +ppTS Open vm r = ppFail Nothing vm r +ppTS (Large n) vm l = do m <- asks (.cfg.campaignConf.shrinkLimit) - ppFail (if n < m then Just (n, m) else Nothing) es l + ppFail (if n < m then Just (n, m) else Nothing) vm l -ppOPT :: MonadReader Env m => TestState -> Events -> [Tx] -> m String +ppOPT :: MonadReader Env m => TestState -> VM RealWorld -> [Tx] -> m String ppOPT (Failed e) _ _ = pure $ "could not evaluate ☣\n " <> show e -ppOPT Solved es l = ppOptimized Nothing es l +ppOPT Solved vm l = ppOptimized Nothing vm l ppOPT Passed _ _ = pure " passed! 🎉" -ppOPT Open es r = ppOptimized Nothing es r -ppOPT (Large n) es l = do +ppOPT Open vm r = ppOptimized Nothing vm r +ppOPT (Large n) vm l = do m <- asks (.cfg.campaignConf.shrinkLimit) - ppOptimized (if n < m then Just (n, m) else Nothing) es l + ppOptimized (if n < m then Just (n, m) else Nothing) vm l -- | Pretty-print the status of a optimized test. -ppOptimized :: MonadReader Env m => Maybe (Int, Int) -> Events -> [Tx] -> m String +ppOptimized :: MonadReader Env m => Maybe (Int, Int) -> VM RealWorld -> [Tx] -> m String ppOptimized _ _ [] = pure "Call sequence:\n(no transactions)" -ppOptimized b es xs = do +ppOptimized b vm xs = do let status = case b of Nothing -> "" Just (n,m) -> ", shrinking " <> progress n m prettyTxs <- mapM (ppTx $ length (nub $ (.src) <$> xs) /= 1) xs + dappInfo <- asks (.dapp) pure $ "\n Call sequence" <> status <> ":\n" <> unlines ((" " <>) <$> prettyTxs) <> "\n" - <> ppEvents es + <> "Traces: \n" <> T.unpack (showTraceTree dappInfo vm) -- | Pretty-print the status of all 'SolTest's in a 'Campaign'. -ppTests :: (MonadReader Env m) => [EchidnaTest] -> m String +ppTests :: MonadReader Env m => [EchidnaTest] -> m String ppTests tests = do unlines . catMaybes <$> mapM pp tests where pp t = case t.testType of PropertyTest n _ -> do - status <- ppTS t.state t.events t.reproducer + status <- ppTS t.state (fromJust t.vm) t.reproducer pure $ Just (T.unpack n <> ": " <> status) CallTest n _ -> do - status <- ppTS t.state t.events t.reproducer + status <- ppTS t.state (fromJust t.vm) t.reproducer pure $ Just (T.unpack n <> ": " <> status) AssertionTest _ s _ -> do - status <- ppTS t.state t.events t.reproducer + status <- ppTS t.state (fromJust t.vm) t.reproducer pure $ Just (T.unpack (encodeSig s) <> ": " <> status) OptimizationTest n _ -> do - status <- ppOPT t.state t.events t.reproducer + status <- ppOPT t.state (fromJust t.vm) t.reproducer pure $ Just (T.unpack n <> ": max value: " <> show t.value <> "\n" <> status) Exploration -> pure Nothing diff --git a/lib/Echidna/UI/Widgets.hs b/lib/Echidna/UI/Widgets.hs index 964b314fe..6bbeec60d 100644 --- a/lib/Echidna/UI/Widgets.hs +++ b/lib/Echidna/UI/Widgets.hs @@ -10,12 +10,15 @@ import Brick.Widgets.Border import Brick.Widgets.Center import Brick.Widgets.Dialog qualified as B import Control.Monad.Reader (MonadReader, asks, ask) +import Control.Monad.ST (RealWorld) import Data.List (nub, intersperse, sortBy) import Data.Map (Map) import Data.Map qualified as Map -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Sequence (Seq) import Data.Sequence qualified as Seq +import Data.String.AnsiEscapeCodes.Strip.Text (stripAnsiEscapeCodes) +import Data.Text (Text) import Data.Text qualified as T import Data.Time (LocalTime, NominalDiffTime, formatTime, defaultTimeLocale, diffLocalTime) import Data.Version (showVersion) @@ -25,7 +28,6 @@ import Text.Printf (printf) import Text.Wrap import Echidna.ABI -import Echidna.Events (Events) import Echidna.Types.Campaign import Echidna.Types.Config import Echidna.Types.Test @@ -33,7 +35,8 @@ import Echidna.Types.Tx (Tx(..), TxResult(..)) import Echidna.UI.Report import Echidna.Utility (timePrefix) -import EVM.Types (Addr, Contract, W256) +import EVM.Format (showTraceTree) +import EVM.Types (Addr, Contract, W256, VM(..)) data UIState = UIState { status :: UIStateStatus @@ -276,36 +279,42 @@ tsWidget -> EchidnaTest -> m (Widget Name, Widget Name) tsWidget (Failed e) _ = pure (str "could not evaluate", str $ show e) -tsWidget Solved t = failWidget Nothing t.reproducer t.events t.value t.result +tsWidget Solved t = failWidget Nothing t.reproducer (fromJust t.vm) t.value t.result tsWidget Passed _ = pure (success $ str "PASSED!", emptyWidget) tsWidget Open _ = pure (success $ str "passing", emptyWidget) tsWidget (Large n) t = do m <- asks (.cfg.campaignConf.shrinkLimit) - failWidget (if n < m then Just (n,m) else Nothing) t.reproducer t.events t.value t.result + failWidget (if n < m then Just (n,m) else Nothing) t.reproducer (fromJust t.vm) t.value t.result titleWidget :: Widget n titleWidget = str "Call sequence" <+> str ":" -eventWidget :: Events -> Widget n -eventWidget es = - if null es then str "" - else str "Event sequence" <+> str ":" - <=> strBreak (T.unpack $ T.intercalate "\n" es) +tracesWidget :: MonadReader Env m => VM RealWorld -> m (Widget n) +tracesWidget vm = do + dappInfo <- asks (.dapp) + -- TODO: showTraceTree does coloring with ANSI escape codes, we need to strip + -- those because they break the Brick TUI. Fix in hevm so we can display + -- colors here as well. + let traces = stripAnsiEscapeCodes $ showTraceTree dappInfo vm + pure $ + if T.null traces then str "" + else str "Traces" <+> str ":" <=> (txtBreak traces) failWidget :: MonadReader Env m => Maybe (Int, Int) -> [Tx] - -> Events + -> VM RealWorld -> TestValue -> TxResult -> m (Widget Name, Widget Name) failWidget _ [] _ _ _= pure (failureBadge, str "*no transactions made*") -failWidget b xs es _ r = do +failWidget b xs vm _ r = do s <- seqWidget xs + traces <- tracesWidget vm pure ( failureBadge <+> str (" with " ++ show r) - , status <=> titleWidget <=> s <=> eventWidget es + , status <=> titleWidget <=> s <=> str " " <=> traces ) where status = case b of @@ -327,21 +336,22 @@ optWidget Open t = "optimizing, max value: " ++ show t.value, emptyWidget) optWidget (Large n) t = do m <- asks (.cfg.campaignConf.shrinkLimit) - maxWidget (if n < m then Just (n,m) else Nothing) t.reproducer t.events t.value + maxWidget (if n < m then Just (n,m) else Nothing) t.reproducer (fromJust t.vm) t.value maxWidget :: MonadReader Env m => Maybe (Int, Int) -> [Tx] - -> Events + -> VM RealWorld -> TestValue -> m (Widget Name, Widget Name) maxWidget _ [] _ _ = pure (failureBadge, str "*no transactions made*") -maxWidget b xs es v = do +maxWidget b xs vm v = do s <- seqWidget xs + traces <- tracesWidget vm pure ( maximumBadge <+> str (" max value: " ++ show v) - , status <=> titleWidget <=> s <=> eventWidget es + , status <=> titleWidget <=> s <=> str " " <=> traces ) where status = case b of @@ -367,4 +377,7 @@ maximumBadge = withAttr (attrName "maximum") $ str "OPTIMIZED!" strBreak :: String -> Widget n strBreak = strWrapWith $ defaultWrapSettings { breakLongWords = True } +txtBreak :: Text -> Widget n +txtBreak = txtWrapWith $ defaultWrapSettings { breakLongWords = True } + #endif diff --git a/package.yaml b/package.yaml index 71c4ac15d..da8b29531 100644 --- a/package.yaml +++ b/package.yaml @@ -49,6 +49,7 @@ dependencies: - http-conduit - html-conduit - xml-conduit + - strip-ansi-escape language: GHC2021 diff --git a/src/test/Tests/Seed.hs b/src/test/Tests/Seed.hs index 62ddddae2..b1b3e5abc 100644 --- a/src/test/Tests/Seed.hs +++ b/src/test/Tests/Seed.hs @@ -7,8 +7,9 @@ import Common (runContract, overrideQuiet) import Data.Function ((&)) import Data.IORef (readIORef) import Echidna.Output.Source (CoverageFileType(..)) -import Echidna.Types.Config (Env(..), EConfig(..)) import Echidna.Types.Campaign +import Echidna.Types.Config (Env(..), EConfig(..)) +import Echidna.Types.Test import Echidna.Mutator.Corpus (defaultMutationConsts) import Echidna.Config (defaultConfig) @@ -39,4 +40,4 @@ seedTests = gen s = do (env, _) <- runContract "basic/flags.sol" Nothing (cfg s) readIORef env.testsRef - same s t = (==) <$> gen s <*> gen t + same s t = (\x y -> ((.reproducer) <$> x) == ((.reproducer) <$> y)) <$> gen s <*> gen t diff --git a/stack.yaml b/stack.yaml index 8d199652e..f82e7e23f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -14,3 +14,4 @@ extra-deps: - spool-0.1@sha256:77780cbfc2c0be23ff2ea9e474062f3df97fcd9db946ee0b3508280a923b83e2,1461 - smt2-parser-0.1.0.1@sha256:1e1a4565915ed851c13d1e6b8bb5185cf5d454da3b43170825d53e221f753d77,1421 - spawn-0.3@sha256:b91e01d8f2b076841410ae284b32046f91471943dc799c1af77d666c72101f02,1162 +- strip-ansi-escape-0.1.0.0@sha256:08f2ed93b16086a837ec46eab7ce8d27cf39d47783caaeb818878ea33c2ff75f,1628