diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index 69d3da288..6053f7c21 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -16,6 +16,7 @@ import Control.Monad.Trans (lift) import Data.Binary.Get (runGetOrFail) import Data.ByteString.Lazy qualified as LBS import Data.IORef (readIORef, atomicModifyIORef') +import Data.List qualified as List import Data.Map qualified as Map import Data.Map (Map, (\\)) import Data.Maybe (isJust, mapMaybe, fromMaybe) @@ -47,7 +48,6 @@ import Echidna.Types.Test qualified as Test import Echidna.Types.Tx (TxCall(..), Tx(..), call) import Echidna.Types.World (World) import Echidna.Utility (getTimestamp) -import qualified Data.List as List instance MonadThrow m => MonadThrow (RandT g m) where throwM = lift . throwM diff --git a/lib/Echidna/Test.hs b/lib/Echidna/Test.hs index bc07d4f91..5972352c3 100644 --- a/lib/Echidna/Test.hs +++ b/lib/Echidna/Test.hs @@ -284,3 +284,23 @@ checkOverflowTest :: DappInfo -> VM RealWorld-> TestValue checkOverflowTest dappInfo vm = let es = extractEvents False dappInfo vm in BoolValue $ null es || not (checkPanicEvent "17" es) + +-- | Reproduce a test saving VM snapshot after every transaction +reproduceTest + :: (MonadIO m, MonadThrow m, MonadReader Env m) + => VM RealWorld -- ^ Initial VM + -> EchidnaTest + -> m ([(Tx, VM RealWorld)], VM RealWorld) +reproduceTest vm0 test = do + let txs = test.reproducer + (results, vm) <- go vm0 [] txs + (_, vm') <- checkETest test vm + pure (results, vm') + where + go vm executedSoFar toExecute = + case toExecute of + [] -> pure ([], vm) + tx:remainingTxs -> do + (_, vm') <- execTx vm tx + (remaining, _) <- go vm' (tx:executedSoFar) remainingTxs + pure ((tx, vm') : remaining, vm') diff --git a/lib/Echidna/UI/Report.hs b/lib/Echidna/UI/Report.hs index ac3dd396e..86c492373 100644 --- a/lib/Echidna/UI/Report.hs +++ b/lib/Echidna/UI/Report.hs @@ -1,5 +1,6 @@ module Echidna.UI.Report where +import Control.Monad (forM) import Control.Monad.Reader (MonadReader, MonadIO (liftIO), asks) import Control.Monad.ST (RealWorld) import Data.IORef (readIORef) @@ -111,6 +112,23 @@ ppFail b vm xs = do <> unlines ((" " <>) <$> prettyTxs) <> "\n" <> "Traces: \n" <> T.unpack (showTraceTree dappInfo vm) +-- | Pretty-print the status of a solved test. +ppFailWithTraces :: MonadReader Env m => Maybe (Int, Int) -> VM RealWorld -> [(Tx, VM RealWorld)] -> m String +ppFailWithTraces _ _ [] = pure "failed with no transactions made ⁉️ " +ppFailWithTraces b finalVM results = do + dappInfo <- asks (.dapp) + let xs = fst <$> results + let status = case b of + Nothing -> "" + Just (n,m) -> ", shrinking " <> progress n m + let printName = length (nub $ (.src) <$> xs) /= 1 + prettyTxs <- forM results $ \(tx, vm) -> do + txPrinted <- ppTx printName tx + pure $ txPrinted <> "\nTraces:\n" <> T.unpack (showTraceTree dappInfo vm) + pure $ "failed!💥 \n Call sequence" <> status <> ":\n" + <> unlines ((" " <>) <$> prettyTxs) <> "\n" + <> "Test traces: \n" <> T.unpack (showTraceTree dappInfo finalVM) + -- | Pretty-print the status of a test. ppTS :: MonadReader Env m => TestState -> VM RealWorld -> [Tx] -> m String @@ -166,6 +184,15 @@ ppTests tests = do pure $ Just (T.unpack n <> ": max value: " <> show t.value <> "\n" <> status) Exploration -> pure Nothing +ppTestName :: EchidnaTest -> String +ppTestName t = + case t.testType of + PropertyTest n _ -> T.unpack n + CallTest n _ -> T.unpack n + AssertionTest _ s _ -> T.unpack (encodeSig s) + OptimizationTest n _ -> T.unpack n <> ": max value: " <> show t.value + Exploration -> "" + -- | Given a number of boxes checked and a number of total boxes, pretty-print -- progress in box-checking. progress :: Int -> Int -> String diff --git a/src/Main.hs b/src/Main.hs index 75c45a680..d78ec207a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,15 +2,16 @@ module Main where -import Control.Monad (unless, forM_) -import Control.Monad.Reader (runReaderT) +import Control.Monad (unless, forM_, when) +import Control.Monad.Reader (runReaderT, liftIO) import Control.Monad.Random (getRandomR) import Data.Aeson.Key qualified as Aeson.Key import Data.Function ((&)) +import Data.Hashable (hash) import Data.IORef (readIORef) import Data.List.NonEmpty qualified as NE import Data.Map qualified as Map -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Data.Set qualified as Set import Data.Text (Text) import Data.Time.Clock.System (getSystemTime, systemSeconds) @@ -19,8 +20,10 @@ import Data.Word (Word8, Word16) import Main.Utf8 (withUtf8) import Options.Applicative import Paths_echidna (version) +import System.Directory (createDirectoryIfMissing) +import System.Environment (lookupEnv) import System.Exit (exitWith, exitSuccess, ExitCode(..)) -import System.FilePath (()) +import System.FilePath ((), (<.>)) import System.IO (hPutStrLn, stderr) import System.IO.CodePage (withCP65001) @@ -35,12 +38,13 @@ import Echidna.Onchain qualified as Onchain import Echidna.Output.Corpus import Echidna.Output.Source import Echidna.Solidity (compileContracts) -import Echidna.Test (validateTestMode) +import Echidna.Test (reproduceTest, validateTestMode) import Echidna.Types.Campaign import Echidna.Types.Config import Echidna.Types.Solidity import Echidna.Types.Test (TestMode, EchidnaTest(..)) import Echidna.UI +import Echidna.UI.Report (ppFailWithTraces, ppTestName) import Echidna.Utility (measureIO) main :: IO () @@ -76,6 +80,20 @@ main = withUtf8 $ withCP65001 $ do Just dir -> do measureIO cfg.solConf.quiet "Saving test reproducers" $ saveTxs (dir "reproducers") (filter (not . null) $ (.reproducer) <$> tests) + + saveTracesEnabled <- lookupEnv "ECHIDNA_SAVE_TRACES" + when (isJust saveTracesEnabled) $ do + measureIO cfg.solConf.quiet "Saving test reproducers-traces" $ do + flip runReaderT env $ do + forM_ tests $ \test -> + unless (null test.reproducer) $ do + (results, finalVM) <- reproduceTest vm test + let subdir = dir "reproducers-traces" + liftIO $ createDirectoryIfMissing True subdir + let file = subdir (show . abs . hash . show) test.reproducer <.> "txt" + txsPrinted <- ppFailWithTraces Nothing finalVM results + liftIO $ writeFile file (ppTestName test <> ": " <> txsPrinted) + measureIO cfg.solConf.quiet "Saving corpus" $ do corpus <- readIORef env.corpusRef saveTxs (dir "coverage") (snd <$> Set.toList corpus)