From a446a6c167ecfdf12da89d8f7ce40fbe008454d6 Mon Sep 17 00:00:00 2001 From: Artur Cygan Date: Thu, 23 Mar 2023 16:44:50 +0100 Subject: [PATCH] Remove prefixes from EchidnaTest (#994) --- lib/Echidna/Campaign.hs | 12 ++-- lib/Echidna/Output/JSON.hs | 8 +-- lib/Echidna/Shrink.hs | 25 ++++--- lib/Echidna/Test.hs | 18 ++--- lib/Echidna/Types/Test.hs | 140 +++++++++++++++++++------------------ lib/Echidna/Types/Tx.hs | 2 +- lib/Echidna/UI.hs | 6 +- lib/Echidna/UI/Report.hs | 12 ++-- lib/Echidna/UI/Widgets.hs | 31 ++++---- src/Main.hs | 2 +- src/test/Common.hs | 4 +- 11 files changed, 130 insertions(+), 130 deletions(-) diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index e50c7756f..b621178a6 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -64,7 +64,7 @@ isDone c = do res (Large i) = if i >= conf.shrinkLimit then Just False else Nothing res Solved = Just False res (Failed _) = Just False - let testResults = res . (.testState) <$> c._tests + let testResults = res . (.state) <$> c._tests let done = if conf.stopOnFail then Just False `elem` testResults else all isJust testResults pure done @@ -73,7 +73,7 @@ isDone c = do -- success or a failure. isSuccessful :: Campaign -> Bool isSuccessful Campaign{_tests} = - all (\case { Passed -> True; Open _ -> True; _ -> False; }) ((.testState) <$> _tests) + all (\case { Passed -> True; Open _ -> True; _ -> False; }) ((.state) <$> _tests) -- | Given an initial 'VM' state and a @('SolTest', 'TestState')@ pair, as well as possibly a sequence -- of transactions and the state after evaluation, see if: @@ -87,10 +87,10 @@ updateTest :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m) updateTest vmForShrink (vm, xs) test = do limit <- asks (.cfg.campaignConf.testLimit) dappInfo <- asks (.dapp) - case test.testState of + case test.state of Open i | i > limit -> case test.testType of - OptimizationTest _ _ -> pure $ test { testState = Large (-1) } - _ -> pure $ test { testState = Passed } + OptimizationTest _ _ -> pure $ test { state = Large (-1) } + _ -> pure $ test { state = Passed } Open i -> do (testValue, vm') <- evalStateT (checkETest test) vm let events = extractEvents False dappInfo vm' @@ -278,7 +278,7 @@ campaign u vm world ts dict initialCorpus = do execStateT (evalRandT (lift u >> runCampaign) (mkStdGen effectiveSeed)) camp where memo = makeBytecodeCache . map (forceBuf . (^. bytecode)) . Map.elems - runCampaign = gets (fmap (.testState) . (._tests)) >>= update + runCampaign = gets (fmap (.state) . (._tests)) >>= update update c = do CampaignConf{testLimit, stopOnFail, seqLen, shrinkLimit} <- asks (.cfg.campaignConf) Campaign{_ncallseqs} <- get diff --git a/lib/Echidna/Output/JSON.hs b/lib/Echidna/Output/JSON.hs index 4a672ed0c..f5b2fd185 100644 --- a/lib/Echidna/Output/JSON.hs +++ b/lib/Echidna/Output/JSON.hs @@ -19,7 +19,7 @@ import Echidna.Types (Gas) import Echidna.Types.Coverage (CoverageInfo) import Echidna.Types.Campaign qualified as C import Echidna.Types.Test qualified as T -import Echidna.Types.Test (EchidnaTest, testState, testReproducer) +import Echidna.Types.Test (EchidnaTest(..)) import Echidna.Types.Tx (Tx(..), TxCall(..)) data Campaign = Campaign @@ -104,10 +104,8 @@ encodeCampaign C.Campaign{..} = encode } mapTest :: EchidnaTest -> Test -mapTest echidnaTest = - let tst = echidnaTest.testState - txs = echidnaTest.testReproducer - (status, transactions, err) = mapTestState tst txs in +mapTest 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 diff --git a/lib/Echidna/Shrink.hs b/lib/Echidna/Shrink.hs index add5a45d0..431e7b5b9 100644 --- a/lib/Echidna/Shrink.hs +++ b/lib/Echidna/Shrink.hs @@ -26,28 +26,27 @@ shrinkTest :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m) shrinkTest vm test = do sl <- asks (.cfg.campaignConf.shrinkLimit) dappInfo <- asks (.dapp) - let x = test.testReproducer - case test.testState of + case test.state of Large i | i >= sl -> - pure $ test { testState = Solved, testReproducer = x } + pure $ test { state = Solved } Large i -> - if length x > 1 || any canShrinkTx x then do - maybeShrunk <- evalStateT (shrinkSeq (checkETest test) test.testValue x) vm + if length test.reproducer > 1 || any canShrinkTx test.reproducer then do + maybeShrunk <- evalStateT (shrinkSeq (checkETest test) test.value test.reproducer) vm pure $ case maybeShrunk of Just (txs, val, vm') -> do - test { testState = Large (i + 1) - , testReproducer = txs - , testEvents = extractEvents False dappInfo vm' - , testResult = getResultFromVM vm' - , testValue = val } + test { state = Large (i + 1) + , reproducer = txs + , events = extractEvents False dappInfo vm' + , result = getResultFromVM vm' + , value = val } Nothing -> -- No success with shrinking this time, just bump trials - test { testState = Large (i + 1) } + test { state = Large (i + 1) } else - pure $ test { testState = if isOptimizationTest test.testType + pure $ test { state = if isOptimizationTest test.testType then Large (i + 1) else Solved - , testReproducer = x } + } _ -> pure test -- | Given a call sequence that solves some Echidna test, try to randomly generate a smaller one that diff --git a/lib/Echidna/Test.hs b/lib/Echidna/Test.hs index 009246191..8afe5e703 100644 --- a/lib/Echidna/Test.hs +++ b/lib/Echidna/Test.hs @@ -97,19 +97,19 @@ createTests m td ts r ss = case m of updateOpenTest :: EchidnaTest -> [Tx] -> Int -> (TestValue, Events, TxResult) -> EchidnaTest updateOpenTest test txs _ (BoolValue False,es,r) = - test { testState = Large (-1), testReproducer = txs, testEvents = es, testResult = r } + test { state = Large (-1), reproducer = txs, events = es, result = r } updateOpenTest test _ i (BoolValue True,_,_) = - test { testState = Open (i + 1) } + test { state = Open (i + 1) } updateOpenTest test txs i (IntValue v',es,r) = if v' > v then - test { testState = Open (i + 1) - , testReproducer = txs - , testValue = IntValue v' - , testEvents = es - , testResult = r } + test { state = Open (i + 1) + , reproducer = txs + , value = IntValue v' + , events = es + , result = r } else - test { testState = Open (i + 1) } - where v = case test.testValue of + test { state = Open (i + 1) } + where v = case test.value of IntValue x -> x _ -> error "Invalid type of value for optimization" updateOpenTest _ _ _ _ = error "Invalid type of test" diff --git a/lib/Echidna/Types/Test.hs b/lib/Echidna/Types/Test.hs index 90f51fd59..287ed4134 100644 --- a/lib/Echidna/Types/Test.hs +++ b/lib/Echidna/Types/Test.hs @@ -6,103 +6,107 @@ import Data.Maybe (maybeToList) import Data.Text (Text) import EVM (VM) -import EVM.Types (Addr) import EVM.Dapp (DappInfo) +import EVM.Types (Addr) import Echidna.Events (Events) -import Echidna.Types -import Echidna.Types.Tx (Tx, TxResult) +import Echidna.Types (ExecException) import Echidna.Types.Signature (SolSignature) +import Echidna.Types.Tx (Tx, TxResult) -- | Test mode is parsed from a string type TestMode = String -- | Configuration for the creation of Echidna tests. -data TestConf = TestConf { classifier :: Text -> VM -> Bool - -- ^ Given a VM state and test name, check if a test just passed (typically - -- examining '_result'.) - , testSender :: Addr -> Addr - -- ^ Given the address of a test, return the address to send test evaluation - -- transactions from. - } - -type TestAttempts = Int - --- | State of a particular Echidna test. N.B.: \"Solved\" means a falsifying call sequence was found. -data TestState = Open Int -- ^ Maybe solvable, tracking attempts already made - | Large Int -- ^ Solved, maybe shrinable, tracking shrinks tried - | Passed -- ^ Presumed unsolvable - | Solved -- ^ Solved with no need for shrinking - | Failed ExecException -- ^ Broke the execution environment - deriving Show - -data TestValue = BoolValue Bool - | IntValue Int256 - | NoValue - deriving (Eq) +data TestConf = TestConf + { classifier :: Text -> VM -> Bool + -- ^ Given a VM state and test name, check if a test just passed (typically + -- examining '_result'.) + , testSender :: Addr -> Addr + -- ^ Given the address of a test, return the address to send test evaluation + -- transactions from. + } + +-- | State of a particular Echidna test. N.B.: 'Solved' means a falsifying +-- call sequence was found. +data TestState + = Open Int -- ^ Maybe solvable, tracking attempts already made + | Large Int -- ^ Solved, maybe shrinable, tracking shrinks tried + | Passed -- ^ Presumed unsolvable + | Solved -- ^ Solved with no need for shrinking + | Failed ExecException -- ^ Broke the execution environment + deriving Show + +data TestValue + = BoolValue Bool + | IntValue Int256 + | NoValue + deriving Eq instance Show TestValue where show (BoolValue x) = show x show (IntValue x) = show x show NoValue = "" -data TestType = PropertyTest Text Addr - | OptimizationTest Text Addr - | AssertionTest Bool SolSignature Addr - | CallTest Text (DappInfo -> VM -> TestValue) - | Exploration +data TestType + = PropertyTest Text Addr + | OptimizationTest Text Addr + | AssertionTest Bool SolSignature Addr + | CallTest Text (DappInfo -> VM -> TestValue) + | Exploration instance Eq TestType where - (PropertyTest t a) == (PropertyTest t' a') = t == t' && a == a' - (AssertionTest b s a) == (AssertionTest b' s' a') = b == b' && s == s' && a == a' - (OptimizationTest s a) == (OptimizationTest s' a') = s == s' && a == a' - (CallTest t _) == (CallTest t' _) = t == t' - Exploration == Exploration = True - _ == _ = False - + PropertyTest t a == PropertyTest t' a' = t == t' && a == a' + AssertionTest b s a == AssertionTest b' s' a' = b == b' && s == s' && a == a' + OptimizationTest s a == OptimizationTest s' a' = s == s' && a == a' + CallTest t _ == CallTest t' _ = t == t' + Exploration == Exploration = True + _ == _ = False instance Eq TestState where - (Open i) == (Open j) = i == j - (Large i) == (Large j) = i == j - Passed == Passed = True - Solved == Solved = True - _ == _ = False + Open i == Open j = i == j + Large i == Large j = i == j + Passed == Passed = True + Solved == Solved = True + _ == _ = False -- | An Echidna test is represented with the following data record -data EchidnaTest = EchidnaTest { - testState :: TestState - , testType :: TestType - , testValue :: TestValue - , testReproducer :: [Tx] - , testResult :: TxResult - , testEvents :: Events - } deriving Eq +data EchidnaTest = EchidnaTest + { state :: TestState + , testType :: TestType + , value :: TestValue + , reproducer :: [Tx] + , result :: TxResult + , events :: Events + } deriving Eq isOptimizationTest :: TestType -> Bool isOptimizationTest (OptimizationTest _ _) = True isOptimizationTest _ = False isOpen :: EchidnaTest -> Bool -isOpen t = case t.testState of - Open _ -> True - _ -> False +isOpen t = case t.state of + Open _ -> True + _ -> False -didFailed :: EchidnaTest -> Bool -didFailed t = case t.testState of - Large _ -> True - Solved -> True - _ -> False +didFail :: EchidnaTest -> Bool +didFail t = case t.state of + Large _ -> True + Solved -> True + _ -> False isPassed :: EchidnaTest -> Bool -isPassed t = case t.testState of - Passed -> True - _ -> False - +isPassed t = case t.state of + Passed -> True + _ -> False instance ToJSON TestState where - toJSON s = object $ ("passed", toJSON passed) : maybeToList desc where - (passed, desc) = case s of Open _ -> (True, Nothing) - Passed -> (True, Nothing) - Large _ -> (False, Nothing) - Solved -> (False, Nothing) - Failed e -> (False, Just ("exception", toJSON $ show e)) + toJSON s = + object $ ("passed", toJSON passed) : maybeToList desc + where + (passed, desc) = case s of + Open _ -> (True, Nothing) + Passed -> (True, Nothing) + Large _ -> (False, Nothing) + Solved -> (False, Nothing) + Failed e -> (False, Just ("exception", toJSON $ show e)) diff --git a/lib/Echidna/Types/Tx.hs b/lib/Echidna/Types/Tx.hs index 353955045..92c494119 100644 --- a/lib/Echidna/Types/Tx.hs +++ b/lib/Echidna/Types/Tx.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module Echidna.Types.Tx where diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index 73aff6427..a03de0370 100644 --- a/lib/Echidna/UI.hs +++ b/lib/Echidna/UI.hs @@ -43,7 +43,7 @@ import Echidna.Types.Campaign import Echidna.Types.Config import Echidna.Types.Corpus (corpusSize) import Echidna.Types.Coverage (scoveragePoints) -import Echidna.Types.Test (EchidnaTest(..), TestState(..), didFailed, isOpen) +import Echidna.Types.Test (EchidnaTest(..), TestState(..), didFail, isOpen) import Echidna.Types.Tx (Tx) import Echidna.Types.World (World) import Echidna.UI.Report @@ -213,12 +213,12 @@ isTerminal = (&&) <$> queryTerminal (Fd 0) <*> queryTerminal (Fd 1) -- | Composes a compact text status line of the campaign statusLine :: CampaignConf -> Campaign -> String statusLine campaignConf camp = - "tests: " <> show (length $ filter didFailed camp._tests) <> "/" <> show (length camp._tests) + "tests: " <> show (length $ filter didFail camp._tests) <> "/" <> show (length camp._tests) <> ", fuzzing: " <> show fuzzRuns <> "/" <> show campaignConf.testLimit <> ", cov: " <> show (scoveragePoints camp._coverage) <> ", corpus: " <> show (corpusSize camp._corpus) where fuzzRuns = case filter isOpen camp._tests of -- fuzzing progress is the same for all Open tests, grab the first one - EchidnaTest { testState = Open t }:_ -> t + EchidnaTest { state = Open t }:_ -> t _ -> campaignConf.testLimit diff --git a/lib/Echidna/UI/Report.hs b/lib/Echidna/UI/Report.hs index e5c41a828..affbec169 100644 --- a/lib/Echidna/UI/Report.hs +++ b/lib/Echidna/UI/Report.hs @@ -14,7 +14,7 @@ import Echidna.Types (Gas) import Echidna.Types.Campaign import Echidna.Types.Corpus (Corpus, corpusSize) import Echidna.Types.Coverage (CoverageMap, scoveragePoints) -import Echidna.Types.Test (testEvents, testState, TestState(..), testType, TestType(..), testReproducer, testValue) +import Echidna.Types.Test (EchidnaTest(..), TestState(..), TestType(..)) import Echidna.Types.Tx (Tx(..), TxCall(..), TxConf(..)) import Echidna.Types.Config @@ -136,17 +136,17 @@ ppTests Campaign { _tests = ts } = unlines . catMaybes <$> mapM pp ts pp t = case t.testType of PropertyTest n _ -> do - status <- ppTS t.testState t.testEvents t.testReproducer + status <- ppTS t.state t.events t.reproducer pure $ Just (T.unpack n <> ": " <> status) CallTest n _ -> do - status <- ppTS t.testState t.testEvents t.testReproducer + status <- ppTS t.state t.events t.reproducer pure $ Just (T.unpack n <> ": " <> status) AssertionTest _ s _ -> do - status <- ppTS t.testState t.testEvents t.testReproducer + status <- ppTS t.state t.events t.reproducer pure $ Just (T.unpack (encodeSig s) <> ": " <> status) OptimizationTest n _ -> do - status <- ppOPT t.testState t.testEvents t.testReproducer - pure $ Just (T.unpack n <> ": max value: " <> show t.testValue <> "\n" <> status) + status <- ppOPT t.state t.events t.reproducer + pure $ Just (T.unpack n <> ": max value: " <> show t.value <> "\n" <> status) Exploration -> pure Nothing -- | Given a number of boxes checked and a number of total boxes, pretty-print progress in box-checking. diff --git a/lib/Echidna/UI/Widgets.hs b/lib/Echidna/UI/Widgets.hs index 11d66f352..78c75cca1 100644 --- a/lib/Echidna/UI/Widgets.hs +++ b/lib/Echidna/UI/Widgets.hs @@ -159,8 +159,8 @@ fetchedDialogWidget uiState = failedFirst :: EchidnaTest -> EchidnaTest -> Ordering -failedFirst t1 _ | didFailed t1 = LT - | otherwise = GT +failedFirst t1 _ | didFail t1 = LT + | otherwise = GT testsWidget :: MonadReader EConfig m => [EchidnaTest] -> m (Widget Name) testsWidget tests' = @@ -172,17 +172,16 @@ testsWidget tests' = traverse testWidget (sortBy failedFirst tests') testWidget :: MonadReader EConfig m => EchidnaTest -> m (Widget Name) -testWidget etest = - case etest.testType of - Exploration -> widget tsWidget "exploration" "" - PropertyTest n _ -> widget tsWidget n "" - OptimizationTest n _ -> widget optWidget n "optimizing " - AssertionTest _ s _ -> widget tsWidget (encodeSig s) "assertion in " - CallTest n _ -> widget tsWidget n "" - +testWidget test = + case test.testType of + Exploration -> widget tsWidget "exploration" "" + PropertyTest n _ -> widget tsWidget n "" + OptimizationTest n _ -> widget optWidget n "optimizing " + AssertionTest _ s _ -> widget tsWidget (encodeSig s) "assertion in " + CallTest n _ -> widget tsWidget n "" where widget f n infront = do - (status, details) <- f (etest.testState) etest + (status, details) <- f test.state test pure $ padLeft (Pad 1) $ str infront <+> name n <+> str ": " <+> status <=> padTop (Pad 1) details @@ -191,7 +190,7 @@ testWidget etest = tsWidget :: MonadReader EConfig m => TestState -> EchidnaTest -> m (Widget Name, Widget Name) tsWidget (Failed e) _ = pure (str "could not evaluate", str $ show e) -tsWidget Solved t = failWidget Nothing t.testReproducer t.testEvents t.testValue t.testResult +tsWidget Solved t = failWidget Nothing t.reproducer t.events t.value t.result tsWidget Passed _ = pure (withAttr (attrName "success") $ str "PASSED!", emptyWidget) tsWidget (Open i) t = do n <- asks (.campaignConf.testLimit) @@ -201,7 +200,7 @@ tsWidget (Open i) t = do pure (withAttr (attrName "working") $ str $ "fuzzing " ++ progress i n, emptyWidget) tsWidget (Large n) t = do m <- asks (.campaignConf.shrinkLimit) - failWidget (if n < m then Just (n,m) else Nothing) t.testReproducer t.testEvents t.testValue t.testResult + failWidget (if n < m then Just (n,m) else Nothing) t.reproducer t.events t.value t.result titleWidget :: Widget n titleWidget = str "Call sequence" <+> str ":" @@ -227,17 +226,17 @@ optWidget :: MonadReader EConfig m => TestState -> EchidnaTest -> m (Widget Name, Widget Name) optWidget (Failed e) _ = pure (str "could not evaluate", str $ show e) optWidget Solved _ = error "optimization tests cannot be solved" -optWidget Passed t = pure (str $ "max value found: " ++ show t.testValue, emptyWidget) +optWidget Passed t = pure (str $ "max value found: " ++ show t.value, emptyWidget) optWidget (Open i) t = do n <- asks (.campaignConf.testLimit) if i >= n then optWidget Passed t else pure (withAttr (attrName "working") $ str $ "optimizing " ++ progress i n - ++ ", current max value: " ++ show t.testValue, emptyWidget) + ++ ", current max value: " ++ show t.value, emptyWidget) optWidget (Large n) t = do m <- asks (.campaignConf.shrinkLimit) - maxWidget (if n < m then Just (n,m) else Nothing) t.testReproducer t.testEvents t.testValue + maxWidget (if n < m then Just (n,m) else Nothing) t.reproducer t.events t.value maxWidget :: MonadReader EConfig m => Maybe (Int, Int) -> [Tx] -> Events -> TestValue -> m (Widget Name, Widget Name) diff --git a/src/Main.hs b/src/Main.hs index 4371ac37e..d95f56875 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -129,7 +129,7 @@ main = withUtf8 $ withCP65001 $ do pure () measureIO cfg.solConf.quiet "Saving test reproducers" $ - saveTxs (dir "reproducers") (filter (not . null) $ (.testReproducer) <$> campaign._tests) + saveTxs (dir "reproducers") (filter (not . null) $ (.reproducer) <$> campaign._tests) measureIO cfg.solConf.quiet "Saving corpus" $ saveTxs (dir "coverage") (snd <$> Set.toList campaign._corpus) diff --git a/src/test/Common.hs b/src/test/Common.hs index 6bc8c6094..a93007ca6 100644 --- a/src/test/Common.hs +++ b/src/test/Common.hs @@ -161,7 +161,7 @@ getResult n c = optnFor :: Text -> Campaign -> Maybe TestValue optnFor n c = case getResult n c of - Just t -> Just t.testValue + Just t -> Just t.value _ -> Nothing optimized :: Text -> Int256 -> Campaign -> Bool @@ -172,7 +172,7 @@ optimized n v c = case optnFor n c of solnFor :: Text -> Campaign -> Maybe [Tx] solnFor n c = case getResult n c of - Just t -> if null t.testReproducer then Nothing else Just t.testReproducer + Just t -> if null t.reproducer then Nothing else Just t.reproducer _ -> Nothing solved :: Text -> Campaign -> Bool