From c840e0a091d00560a56aabe484a89fc079086b19 Mon Sep 17 00:00:00 2001 From: Sam Alws Date: Fri, 6 Sep 2024 09:27:28 -0400 Subject: [PATCH] (WIP) coverage during init --- lib/Echidna.hs | 5 +++-- lib/Echidna/Campaign.hs | 2 +- lib/Echidna/Deploy.hs | 6 +++--- lib/Echidna/Exec.hs | 5 ++++- lib/Echidna/Output/JSON.hs | 4 ++-- lib/Echidna/Output/Source.hs | 35 +++++++++++++++++------------------ lib/Echidna/Solidity.hs | 7 ++++--- lib/Echidna/Types/Config.hs | 3 ++- lib/Echidna/Types/Coverage.hs | 20 ++++++++++++++++++-- lib/Echidna/UI.hs | 4 +++- lib/Echidna/UI/Report.hs | 12 +++++++++--- 11 files changed, 66 insertions(+), 37 deletions(-) diff --git a/lib/Echidna.hs b/lib/Echidna.hs index 115b7d8bf..68f32745e 100644 --- a/lib/Echidna.hs +++ b/lib/Echidna.hs @@ -118,7 +118,8 @@ mkEnv cfg buildOutput tests world slitherInfo = do codehashMap <- newIORef mempty chainId <- maybe (pure Nothing) EVM.Fetch.fetchChainIdFrom cfg.rpcUrl eventQueue <- newChan - coverageRef <- newIORef mempty + coverageRefInit <- newIORef mempty + coverageRefRuntime <- newIORef mempty corpusRef <- newIORef mempty testRefs <- traverse newIORef tests (contractCache, slotCache) <- Onchain.loadRpcCache cfg @@ -127,6 +128,6 @@ mkEnv cfg buildOutput tests world slitherInfo = do -- TODO put in real path let dapp = dappInfo "/" buildOutput pure $ Env { cfg, dapp, codehashMap, fetchContractCache, fetchSlotCache - , chainId, eventQueue, coverageRef, corpusRef, testRefs, world + , chainId, eventQueue, coverageRefInit, coverageRefRuntime, corpusRef, testRefs, world , slitherInfo } diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index dad687231..1ab8a2478 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -353,7 +353,7 @@ callseq vm txSeq = do let !corp' = force $ addToCorpus (ncallseqs + 1) results corp in (corp', corpusSize corp') - cov <- liftIO . readIORef =<< asks (.coverageRef) + cov <- liftIO . readIORef =<< asks (.coverageRefRuntime) points <- liftIO $ scoveragePoints cov pushWorkerEvent NewCoverage { points , numCodehashes = length cov diff --git a/lib/Echidna/Deploy.hs b/lib/Echidna/Deploy.hs index fa2e4ae74..72e75e056 100644 --- a/lib/Echidna/Deploy.hs +++ b/lib/Echidna/Deploy.hs @@ -3,7 +3,7 @@ module Echidna.Deploy where import Control.Monad (foldM) import Control.Monad.Catch (MonadThrow(..), throwM) import Control.Monad.Reader (MonadReader, asks) -import Control.Monad.State.Strict (MonadIO) +import Control.Monad.State.Strict (MonadIO, runStateT) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Base16 qualified as BS16 (decode) @@ -14,7 +14,7 @@ import Data.Text.Encoding (encodeUtf8) import EVM.Solidity import EVM.Types hiding (Env) -import Echidna.Exec (execTx) +import Echidna.Exec (execTxWithCov) import Echidna.Events (extractEvents) import Echidna.Types.Config (Env(..)) import Echidna.Types.Solidity (SolException(..)) @@ -51,7 +51,7 @@ deployBytecodes' cs src initialVM = foldM deployOne initialVM cs where deployOne vm (dst, bytecode) = do (_, vm') <- - execTx vm $ createTx (bytecode <> zeros) src dst unlimitedGasPerBlock (0, 0) + runStateT (execTxWithCov $ createTx (bytecode <> zeros) src dst unlimitedGasPerBlock (0, 0)) vm case vm'.result of Just (VMSuccess _) -> pure vm' _ -> do diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index f76691897..163919b28 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -287,8 +287,11 @@ execTxWithCov tx = do addCoverage !vm = do let (pc, opIx, depth) = currentCovLoc vm contract = currentContract vm + covRef = case contract.code of + InitCode _ _ -> env.coverageRefInit + _ -> env.coverageRefRuntime - maybeCovVec <- lookupUsingCodehashOrInsert env.codehashMap contract env.dapp env.coverageRef $ do + maybeCovVec <- lookupUsingCodehashOrInsert env.codehashMap contract env.dapp covRef $ do let size = BS.length . forceBuf . fromJust . view bytecode $ contract if size == 0 then pure Nothing else do -- IO for making a new vec diff --git a/lib/Echidna/Output/JSON.hs b/lib/Echidna/Output/JSON.hs index 39bcaa503..9a864d782 100644 --- a/lib/Echidna/Output/JSON.hs +++ b/lib/Echidna/Output/JSON.hs @@ -20,7 +20,7 @@ import Echidna.Events (Events, extractEvents) import Echidna.Types (Gas) import Echidna.Types.Campaign (WorkerState(..)) import Echidna.Types.Config (Env(..)) -import Echidna.Types.Coverage (CoverageInfo) +import Echidna.Types.Coverage (CoverageInfo, mergeCoverageMaps) import Echidna.Types.Test qualified as T import Echidna.Types.Test (EchidnaTest(..)) import Echidna.Types.Tx (Tx(..), TxCall(..)) @@ -101,7 +101,7 @@ instance ToJSON Transaction where encodeCampaign :: Env -> [WorkerState] -> IO L.ByteString encodeCampaign env workerStates = do tests <- traverse readIORef env.testRefs - frozenCov <- mapM VU.freeze =<< readIORef env.coverageRef + frozenCov <- mergeCoverageMaps env.dapp env.coverageRefInit env.coverageRefRuntime -- TODO: this is ugly, refactor seed to live in Env let worker0 = Prelude.head workerStates pure $ encode Campaign diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index 6c491b91b..c2e9c2da0 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -7,7 +7,6 @@ import Prelude hiding (writeFile) import Control.Monad (unless) import Data.ByteString qualified as BS import Data.Foldable -import Data.IORef (readIORef) import Data.List (nub, sort) import Data.Maybe (fromMaybe, mapMaybe) import Data.Map (Map) @@ -19,7 +18,7 @@ import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8) import Data.Text.IO (writeFile) import Data.Vector qualified as V -import Data.Vector.Unboxed.Mutable qualified as VU +import Data.Vector.Unboxed qualified as VU import HTMLEntities.Text qualified as HTML import System.Directory (createDirectoryIfMissing) import System.FilePath (()) @@ -30,7 +29,7 @@ import EVM.Solidity (SourceCache(..), SrcMap, SolcContract(..)) import Echidna.Types.Campaign (CampaignConf(..)) import Echidna.Types.Config (Env(..), EConfig(..)) -import Echidna.Types.Coverage (OpIx, unpackTxResults, CoverageMap, CoverageFileType (..)) +import Echidna.Types.Coverage (OpIx, unpackTxResults, FrozenCoverageMap, CoverageFileType (..), mergeCoverageMaps) import Echidna.Types.Tx (TxResult(..)) import Echidna.SourceAnalysis.Slither (AssertLocation(..), assertLocationList, SlitherInfo(..)) @@ -43,7 +42,7 @@ saveCoverages -> IO () saveCoverages env seed d sc cs = do let fileTypes = env.cfg.campaignConf.coverageFormats - coverage <- readIORef env.coverageRef + coverage <- mergeCoverageMaps env.dapp env.coverageRefInit env.coverageRefRuntime mapM_ (\ty -> saveCoverage ty seed d sc cs coverage) fileTypes saveCoverage @@ -52,12 +51,12 @@ saveCoverage -> FilePath -> SourceCache -> [SolcContract] - -> CoverageMap + -> FrozenCoverageMap -> IO () saveCoverage fileType seed d sc cs covMap = do let extension = coverageFileExtension fileType fn = d "covered." <> show seed <> extension - cc <- ppCoveredCode fileType sc cs covMap + cc = ppCoveredCode fileType sc cs covMap createDirectoryIfMissing True d writeFile fn cc @@ -67,12 +66,12 @@ coverageFileExtension Html = ".html" coverageFileExtension Txt = ".txt" -- | Pretty-print the covered code -ppCoveredCode :: CoverageFileType -> SourceCache -> [SolcContract] -> CoverageMap -> IO Text -ppCoveredCode fileType sc cs s | null s = pure "Coverage map is empty" - | otherwise = do - -- List of covered lines during the fuzzing campaign - covLines <- srcMapCov sc s cs +ppCoveredCode :: CoverageFileType -> SourceCache -> [SolcContract] -> FrozenCoverageMap -> Text +ppCoveredCode fileType sc cs s | null s = "Coverage map is empty" + | otherwise = let + -- List of covered lines during the fuzzing campaign + covLines = srcMapCov sc s cs -- Collect all the possible lines from all the files allFiles = (\(path, src) -> (path, V.fromList (decodeUtf8 <$> BS.split 0xa src))) <$> Map.elems sc.files -- Excludes lines such as comments or blanks @@ -102,7 +101,7 @@ ppCoveredCode fileType sc cs s | null s = pure "Coverage map is empty" Html -> "" : ls ++ ["", "","
"] Txt -> ls -- ^ Alter file contents, in the case of html encasing it in and adding a line break - pure $ topHeader <> T.unlines (map ppFile allFiles) + in topHeader <> T.unlines (map ppFile allFiles) -- | Mark one particular line, from a list of lines, keeping the order of them markLines :: CoverageFileType -> V.Vector Text -> S.Set Int -> Map Int [TxResult] -> V.Vector Text @@ -148,11 +147,11 @@ getMarker ErrorOutOfGas = 'o' getMarker _ = 'e' -- | Given a source cache, a coverage map, a contract returns a list of covered lines -srcMapCov :: SourceCache -> CoverageMap -> [SolcContract] -> IO (Map FilePath (Map Int [TxResult])) -srcMapCov sc covMap contracts = do - Map.unionsWith Map.union <$> mapM linesCovered contracts +srcMapCov :: SourceCache -> FrozenCoverageMap -> [SolcContract] -> Map FilePath (Map Int [TxResult]) +srcMapCov sc covMap contracts = + Map.unionsWith Map.union $ linesCovered <$> contracts where - linesCovered :: SolcContract -> IO (Map FilePath (Map Int [TxResult])) + linesCovered :: SolcContract -> Map FilePath (Map Int [TxResult]) linesCovered c = case Map.lookup c.runtimeCodehash covMap of Just vec -> VU.foldl' (\acc covInfo -> case covInfo of @@ -197,11 +196,11 @@ checkAssertionsCoverage -> Env -> IO () checkAssertionsCoverage sc env = do + covMap <- mergeCoverageMaps env.dapp env.coverageRefInit env.coverageRefRuntime let cs = Map.elems env.dapp.solcByName asserts = maybe [] (concatMap assertLocationList . Map.elems . (.asserts)) env.slitherInfo - covMap <- readIORef env.coverageRef - covLines <- srcMapCov sc covMap cs + covLines = srcMapCov sc covMap cs mapM_ (checkAssertionReached covLines) asserts -- | Helper function for `checkAssertionsCoverage` which checks a single assertion diff --git a/lib/Echidna/Solidity.hs b/lib/Echidna/Solidity.hs index 990309ee5..39a8dd8db 100644 --- a/lib/Echidna/Solidity.hs +++ b/lib/Echidna/Solidity.hs @@ -7,6 +7,7 @@ import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.Extra (whenM) import Control.Monad.Reader (ReaderT(runReaderT)) import Control.Monad.ST (stToIO, RealWorld) +import Control.Monad.State (runStateT) import Data.Foldable (toList) import Data.List (find, partition, isSuffixOf, (\\)) import Data.List.NonEmpty (NonEmpty((:|))) @@ -39,7 +40,7 @@ import Echidna.ABI import Echidna.Deploy (deployContracts, deployBytecodes) import Echidna.Etheno (loadEthenoBatch) import Echidna.Events (extractEvents) -import Echidna.Exec (execTx, initialVM) +import Echidna.Exec (execTx, execTxWithCov, initialVM) import Echidna.SourceAnalysis.Slither import Echidna.Test (createTests, isAssertionMode, isPropertyMode, isDapptestMode) import Echidna.Types.Config (EConfig(..), Env(..)) @@ -199,13 +200,13 @@ loadSpecified env mainContract cs = do vm2 <- deployBytecodes solConf.deployBytecodes solConf.deployer vm1 -- main contract deployment - let deployment = execTx vm2 $ createTxWithValue + let deployment = runStateT (execTxWithCov $ createTxWithValue mainContract.creationCode solConf.deployer solConf.contractAddr unlimitedGasPerBlock (fromIntegral solConf.balanceContract) - (0, 0) + (0, 0)) vm2 (_, vm3) <- deployment when (isNothing $ currentContract vm3) $ throwM $ DeploymentFailed solConf.contractAddr $ T.unlines $ extractEvents True env.dapp vm3 diff --git a/lib/Echidna/Types/Config.hs b/lib/Echidna/Types/Config.hs index 5026c62d3..c2fa2b4c1 100644 --- a/lib/Echidna/Types/Config.hs +++ b/lib/Echidna/Types/Config.hs @@ -71,7 +71,8 @@ data Env = Env , eventQueue :: Chan (LocalTime, CampaignEvent) , testRefs :: [IORef EchidnaTest] - , coverageRef :: IORef CoverageMap + , coverageRefInit :: IORef CoverageMap + , coverageRefRuntime :: IORef CoverageMap , corpusRef :: IORef Corpus , slitherInfo :: Maybe SlitherInfo diff --git a/lib/Echidna/Types/Coverage.hs b/lib/Echidna/Types/Coverage.hs index 8d1241172..d40d4e637 100644 --- a/lib/Echidna/Types/Coverage.hs +++ b/lib/Echidna/Types/Coverage.hs @@ -2,13 +2,17 @@ module Echidna.Types.Coverage where import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), withText) import Data.Bits (testBit) +import Data.IORef (IORef, readIORef) import Data.List (foldl') import Data.Map qualified as Map import Data.Map.Strict (Map) import Data.Text (toLower) import Data.Vector.Unboxed.Mutable (IOVector) -import Data.Vector.Unboxed.Mutable qualified as V +import Data.Vector.Unboxed.Mutable qualified as VM +import Data.Vector.Unboxed qualified as V import Data.Word (Word64) +import EVM.Dapp (DappInfo(..)) +import EVM.Solidity (SolcContract(..)) import EVM.Types (W256) import Echidna.Types.Tx (TxResult) @@ -17,6 +21,8 @@ import Echidna.Types.Tx (TxResult) -- Indexed by contracts' compile-time codehash; see `CodehashMap`. type CoverageMap = Map W256 (IOVector CoverageInfo) +type FrozenCoverageMap = Map W256 (V.Vector CoverageInfo) + -- | Basic coverage information type CoverageInfo = (OpIx, StackDepths, TxResults) @@ -29,12 +35,22 @@ type StackDepths = Word64 -- | Packed TxResults used for coverage, corresponding bits are set type TxResults = Word64 +mergeCoverageMaps :: DappInfo -> IORef CoverageMap -> IORef CoverageMap -> IO FrozenCoverageMap +mergeCoverageMaps dapp initMap runtimeMap = do + initMap' <- Map.mapWithKey modifyInitMapEntry <$> (mapM V.freeze =<< readIORef initMap) + runtimeMap' <- mapM V.freeze =<< readIORef runtimeMap + pure $ Map.unionWith (<>) initMap' runtimeMap' + where + modifyInitMapEntry hash vec = V.map (modifyCoverageInfo (getOpOffset hash)) vec + modifyCoverageInfo toAdd (op, x, y) = (op + toAdd, x, y) + getOpOffset hash = maybe 0 (length . (.runtimeSrcmap) . snd) $ Map.lookup hash dapp.solcByHash + -- | Given good point coverage, count the number of unique points but -- only considering the different instruction PCs (discarding the TxResult). -- This is useful for reporting a coverage measure to the user scoveragePoints :: CoverageMap -> IO Int scoveragePoints cm = do - sum <$> mapM (V.foldl' countCovered 0) (Map.elems cm) + sum <$> mapM (VM.foldl' countCovered 0) (Map.elems cm) countCovered :: Int -> CoverageInfo -> Int countCovered acc (opIx,_,_) = if opIx == -1 then acc else acc + 1 diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index dcbccdc13..d769401b5 100644 --- a/lib/Echidna/UI.hs +++ b/lib/Echidna/UI.hs @@ -339,7 +339,9 @@ statusLine -> IO String statusLine env states = do tests <- traverse readIORef env.testRefs - points <- scoveragePoints =<< readIORef env.coverageRef + pointsInit <- scoveragePoints =<< readIORef env.coverageRefInit + pointsRuntime <- scoveragePoints =<< readIORef env.coverageRefRuntime + let points = pointsInit + pointsRuntime corpus <- readIORef env.corpusRef let totalCalls = sum ((.ncalls) <$> states) pure $ "tests: " <> show (length $ filter didFail tests) <> "/" <> show (length tests) diff --git a/lib/Echidna/UI/Report.hs b/lib/Echidna/UI/Report.hs index 580267b67..b831ca7ee 100644 --- a/lib/Echidna/UI/Report.hs +++ b/lib/Echidna/UI/Report.hs @@ -8,6 +8,7 @@ import Data.List (intercalate, nub, sortOn) import Data.Map (toList) import Data.Map qualified as Map import Data.Maybe (catMaybes, fromJust, fromMaybe) +import Data.Set qualified as Set import Data.Text (Text, unpack) import Data.Text qualified as T import Data.Time (LocalTime) @@ -97,10 +98,15 @@ ppDelay (time, block) = -- | Pretty-print the coverage a 'Campaign' has obtained. ppCoverage :: (MonadIO m, MonadReader Env m) => m String ppCoverage = do - coverage <- liftIO . readIORef =<< asks (.coverageRef) - points <- liftIO $ scoveragePoints coverage + coverageInit <- liftIO . readIORef =<< asks (.coverageRefInit) + coverageRuntime <- liftIO . readIORef =<< asks (.coverageRefRuntime) + pointsInit <- liftIO $ scoveragePoints coverageInit + pointsRuntime <- liftIO $ scoveragePoints coverageRuntime + let + points = pointsInit + pointsRuntime + uniqueCodehashes = length $ Set.fromList $ Map.keys coverageInit ++ Map.keys coverageRuntime pure $ "Unique instructions: " <> show points <> "\n" <> - "Unique codehashes: " <> show (length coverage) + "Unique codehashes: " <> show uniqueCodehashes -- | Pretty-print the corpus a 'Campaign' has obtained. ppCorpus :: (MonadIO m, MonadReader Env m) => m String