Cleanup

lib/Echidna/Campaign.hs

@@ -4,7 +4,7 @@ module Echidna.Campaign where
 
 import Optics.Core hiding ((|>))
 
-import Control.Concurrent (writeChan, threadDelay)
+import Control.Concurrent (writeChan)
 import Control.DeepSeq (force)
 import Control.Monad (replicateM, when, unless, void, forM_)
 import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
@@ -53,29 +53,6 @@ instance MonadThrow m => MonadThrow (RandT g m) where
 instance MonadCatch m => MonadCatch (RandT g m) where
   catch = liftCatch catch
 
--- | Given a 'Campaign', checks if we can attempt any solves or shrinks without exceeding
--- the limits defined in our 'CampaignConf'.
-isDone :: MonadReader Env m => [Campaign] -> m Bool
-isDone _ = pure False
-  {-
-isDone c | null c.tests = do
-  conf <- asks (.cfg.campaignConf)
-  pure $ c.ncallseqs * conf.seqLen >= conf.testLimit
-isDone c = do
-  conf <- asks (.cfg.campaignConf)
-  let
-    result = \case
-      Open     -> Nothing
-      Passed   -> Just True
-      Large i  -> if i >= conf.shrinkLimit then Just False else Nothing
-      Solved   -> Just False
-      Failed _ -> Just False
-    testResults = result . (.state) <$> c.tests
-    done = if conf.stopOnFail then Just False `elem` testResults
-                              else all isJust testResults
-  pure done
-  -}
-
 -- | Given a 'Campaign', check if the test results should be reported as a
 -- success or a failure.
 isSuccessful :: [EchidnaTest] -> Bool
@@ -125,7 +102,6 @@ runCampaign callback vm world dict workerId initialCorpus = do
                         , workerId
                         }
 
-  when (workerId > 0) $ liftIO $ threadDelay 5_000_000
   flip execStateT campaign $ do
     flip evalRandT (mkStdGen effectiveSeed) $ do
       void $ lift callback
@@ -135,23 +111,22 @@ runCampaign callback vm world dict workerId initialCorpus = do
   where
   run = do
     tests <- liftIO . readIORef =<< asks (.testsRef)
-    CampaignConf{testLimit, stopOnFail, seqLen, shrinkLimit} <- asks (.cfg.campaignConf)
-    Campaign{ncallseqs} <- get
+    CampaignConf{stopOnFail, shrinkLimit} <- asks (.cfg.campaignConf)
+
     let
-      testStates = (.state) <$> tests
-      stopEarlier =
-        stopOnFail && any (\case Solved -> True; Failed _ -> True; _ -> False)
-                          testStates
-    if | stopEarlier ->
-         void $ lift callback
-       | any (\case Open -> True; _ -> False) testStates ->
-         fuzz >> continue
-       | any (\case Large n -> n < shrinkLimit; _ -> False) testStates ->
-         continue
-       | null testStates && (seqLen * ncallseqs) <= testLimit ->
-         fuzz >> continue
-       | otherwise ->
-         void $ lift callback
+      final test = case test.state of
+                    Solved   -> True
+                    Failed _ -> True
+                    _        -> False
+
+      shrinkable test = case test.state of
+                          Large n -> n < shrinkLimit
+                          _       -> False
+
+    if | stopOnFail && any final tests  -> void $ lift callback
+       | null tests || any isOpen tests -> fuzz >> continue
+       | any shrinkable tests           -> continue
+       | otherwise                      -> void $ lift callback
 
   fuzz = randseq vm.env.contracts world >>= callseq vm
 

lib/Echidna/Types/Campaign.hs

@@ -88,7 +88,7 @@ defaultCampaign :: Campaign
 defaultCampaign = Campaign mempty emptyDict False 0 0 0
 
 defaultTestLimit :: Int
-defaultTestLimit = 5000000
+defaultTestLimit = 50000
 
 defaultSequenceLength :: Int
 defaultSequenceLength = 100

lib/Echidna/UI.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
 
 module Echidna.UI where
 

lib/Echidna/UI/Report.hs

@@ -163,4 +163,4 @@ ppTests tests = do
 
 -- | Given a number of boxes checked and a number of total boxes, pretty-print progress in box-checking.
 progress :: Int -> Int -> String
-progress n m = "(" <> show n <> "/" <> show m <> ")"
+progress n m = show n <> "/" <> show m

lib/Echidna/UI/Widgets.hs

@@ -9,7 +9,7 @@ import Brick.AttrMap qualified as A
 import Brick.Widgets.Border
 import Brick.Widgets.Center
 import Brick.Widgets.Dialog qualified as B
-import Control.Monad.Reader (MonadReader, asks)
+import Control.Monad.Reader (MonadReader, asks, ask)
 import Data.List (nub, intersperse, sortBy)
 import Data.Map (Map)
 import Data.Map qualified as Map
@@ -25,7 +25,6 @@ import Text.Printf (printf)
 import Text.Wrap
 
 import Echidna.ABI
-import Echidna.Campaign (isDone)
 import Echidna.Events (Events)
 import Echidna.Types.Campaign
 import Echidna.Types.Config
@@ -91,7 +90,7 @@ data Name
 -- | Render 'Campaign' progress as a 'Widget'.
 campaignStatus :: MonadReader Env m => UIState -> m (Widget Name)
 campaignStatus uiState = do
-  done <- isDone uiState.campaigns
+  done <- pure False -- isDone uiState.tests
   case (uiState.status, done) of
     (Uninitialized, _) ->
       mainbox (padLeft (Pad 1) $ str "Starting up, please wait...") emptyWidget
@@ -110,9 +109,9 @@ campaignStatus uiState = do
   mainbox inner underneath =
     hCenter . hLimit 120 <$> wrapInner inner underneath
   wrapInner inner underneath = do
-    chainId <- asks (.chainId)
+    env <- ask
     pure $ joinBorders $ borderWithLabel echidnaTitle $
-      summaryWidget uiState chainId
+      summaryWidget env uiState
       <=>
       hBorderWithLabel (withAttr (attrName "subtitle") $ str $
         (" Tests (" <> show (length uiState.tests)) <> ") ")
@@ -153,8 +152,8 @@ formatCrashReport e =
   e <>
   "\n\nPlease report it to https://github.com/crytic/echidna/issues"
 
-summaryWidget :: UIState -> Maybe W256 -> Widget Name
-summaryWidget uiState chainId =
+summaryWidget :: Env -> UIState -> Widget Name
+summaryWidget env uiState =
   vLimit 5 $ -- limit to 5 rows
     hLimitPercent 33 leftSide <+> vBorder <+>
     hLimitPercent 50 middle <+> vBorder <+>
@@ -170,19 +169,20 @@ summaryWidget uiState chainId =
       <=>
       perfWidget uiState
       <=>
-      str ("Total txs: " ++ show (sum $ (.totalTxsExecuted) <$> uiState.campaigns))
+      str ("Total txs: " <> progress (sum $ (.totalTxsExecuted) <$> uiState.campaigns)
+                                     env.cfg.campaignConf.testLimit)
   middle =
     padLeft (Pad 1) $
       str ("Unique instructions: " <> show uiState.coverage)
       <=>
       str ("Unique codehashes: " <> show uiState.numCodehashes)
       <=>
-      str ("Corpus size: " <> show uiState.corpusSize <> " seqs") <+> fill ' '
+      str ("Corpus size: " <> show uiState.corpusSize <> " seqs")
       <=>
-      str ("New coverage: " <> timeElapsed uiState uiState.lastNewCov <> " ago")
+      str ("New coverage: " <> timeElapsed uiState uiState.lastNewCov <> " ago") <+> fill ' '
   rightSide =
     padLeft (Pad 1) $
-      (rpcInfoWidget uiState.fetchedContracts uiState.fetchedSlots chainId)
+      (rpcInfoWidget uiState.fetchedContracts uiState.fetchedSlots env.chainId)
 
 timeElapsed :: UIState -> LocalTime -> String
 timeElapsed uiState since =
@@ -211,7 +211,7 @@ rpcInfoWidget contracts slots chainId =
   countWidget fetches =
     let successful = filter isJust fetches
         style = if length successful == length fetches then success else failure
-    in style . str $ show (length successful) <> "/" <> show (length fetches)
+    in style . str $ progress (length successful) (length fetches)
 
 perfWidget :: UIState -> Widget n
 perfWidget uiState =

src/test/Tests/Compile.hs

@@ -46,6 +46,7 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where
     eventQueue <- newChan
     coverageRef <- newIORef mempty
     corpusRef <- newIORef mempty
+    testsRef <- newIORef mempty
     let env = Env { cfg = testConfig
                   , dapp = emptyDapp
                   , metadataCache = cacheMeta
@@ -55,5 +56,6 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where
                   , eventQueue
                   , coverageRef
                   , corpusRef
+                  , testsRef
                   }
     void $ loadSolTests env (fp :| []) c

src/test/Tests/Integration.hs

@@ -2,7 +2,7 @@ module Tests.Integration (integrationTests) where
 
 import Test.Tasty (TestTree, testGroup)
 
-import Common (testContract, testContractV, solcV, testContract', checkConstructorConditions, passed, solved, solvedLen, solvedWith, solvedWithout, gasInRange)
+import Common (testContract, testContractV, solcV, testContract', checkConstructorConditions, passed, solved, solvedLen, solvedWith, solvedWithout)
 import Data.Functor ((<&>))
 import Data.Text (unpack)
 import Echidna.Types.Tx (TxCall(..))