diff --git a/lib/Echidna.hs b/lib/Echidna.hs index 64b84fe93..ec7f5dd52 100644 --- a/lib/Echidna.hs +++ b/lib/Echidna.hs @@ -9,6 +9,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map import Data.Set qualified as Set +import Data.TLS.GHC (mkTLS) import System.FilePath (()) import EVM (cheatCode) @@ -119,6 +120,7 @@ mkEnv cfg buildOutput tests world = do chainId <- maybe (pure Nothing) EVM.Fetch.fetchChainIdFrom cfg.rpcUrl eventQueue <- newChan coverageRef <- newIORef mempty + statsRef <- mkTLS $ newIORef mempty corpusRef <- newIORef mempty testRefs <- traverse newIORef tests (contractCache, slotCache) <- Onchain.loadRpcCache cfg @@ -127,5 +129,5 @@ mkEnv cfg buildOutput tests world = 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, coverageRef, statsRef, corpusRef, testRefs, world } diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index f76691897..fd4c6524b 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -7,7 +7,7 @@ module Echidna.Exec where import Optics.Core import Optics.State.Operators -import Control.Monad (when, forM_) +import Control.Monad (when) import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.State.Strict (MonadState(get, put), execState, runStateT, MonadIO(liftIO), gets, modify', execStateT) import Control.Monad.Reader (MonadReader, ask, asks) @@ -18,6 +18,7 @@ import Data.IORef (readIORef, atomicWriteIORef, newIORef, writeIORef, modifyIORe import Data.Map qualified as Map import Data.Maybe (fromMaybe, fromJust) import Data.Text qualified as T +import Data.TLS.GHC (getTLS) import Data.Vector qualified as V import Data.Vector.Unboxed.Mutable qualified as VMut import System.Process (readProcessWithExitCode) @@ -287,14 +288,20 @@ execTxWithCov tx = do addCoverage !vm = do let (pc, opIx, depth) = currentCovLoc vm contract = currentContract vm + contractSize = BS.length . forceBuf . fromJust . view bytecode $ contract maybeCovVec <- lookupUsingCodehashOrInsert env.codehashMap contract env.dapp env.coverageRef $ do - let size = BS.length . forceBuf . fromJust . view bytecode $ contract - if size == 0 then pure Nothing else do + if contractSize == 0 then pure Nothing else do -- IO for making a new vec - vec <- VMut.new size -- We use -1 for opIx to indicate that the location was not covered - forM_ [0..size-1] $ \i -> VMut.write vec i (-1, 0, 0) + vec <- VMut.replicate contractSize (-1, 0, 0) + pure $ Just vec + + statsRef <- getTLS env.statsRef + maybeStatsVec <- lookupUsingCodehashOrInsert env.codehashMap contract env.dapp statsRef $ do + if contractSize == 0 then pure Nothing else do + -- IO for making a new vec + vec <- VMut.replicate contractSize (0, 0) pure $ Just vec case maybeCovVec of @@ -305,7 +312,8 @@ execTxWithCov tx = do -- bug in another place, investigate. -- ... this should be fixed now, since we use `codeContract` instead -- of `contract` for everything; it may be safe to remove this check. - when (pc < VMut.length vec) $ + when (pc < VMut.length vec) $ do + VMut.modify (fromJust maybeStatsVec) (\(execQty, revertQty) -> (execQty + 1, revertQty)) opIx VMut.read vec pc >>= \case (_, depths, results) | depth < 64 && not (depths `testBit` depth) -> do VMut.write vec pc (opIx, depths `setBit` depth, results `setBit` fromEnum Stop) diff --git a/lib/Echidna/Output/Source.hs b/lib/Echidna/Output/Source.hs index c6c3ab98f..8d8cde0c8 100644 --- a/lib/Echidna/Output/Source.hs +++ b/lib/Echidna/Output/Source.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ParallelListComp #-} module Echidna.Output.Source where @@ -6,7 +7,7 @@ import Prelude hiding (writeFile) import Data.ByteString qualified as BS import Data.Foldable -import Data.IORef (readIORef) +import Data.IORef (readIORef, IORef) import Data.List (nub, sort) import Data.Maybe (fromMaybe, mapMaybe) import Data.Map (Map) @@ -17,7 +18,9 @@ import Data.Text (Text, pack) import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8) import Data.Text.IO (writeFile) +import Data.TLS.GHC (allTLS, TLS) import Data.Vector qualified as V +import qualified Data.Vector.Unboxed as U import Data.Vector.Unboxed.Mutable qualified as VU import HTMLEntities.Text qualified as HTML import System.Directory (createDirectoryIfMissing) @@ -29,8 +32,25 @@ 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, CoverageMap, CoverageFileType (..), StatsMap, StatsMapV, StatsInfo) import Echidna.Types.Tx (TxResult(..)) +import EVM.Types (W256) + +zipSumStats :: IO [StatsInfo] -> IO [StatsInfo] -> IO [StatsInfo] +zipSumStats v1 v2 = do + vec1 <- v1 + vec2 <- v2 + return [(exec1 + exec2, revert1 + revert2) | (exec1, revert1) <- vec1 | (exec2, revert2) <- vec2] + +combineStats :: TLS (IORef StatsMap) -> IO StatsMapV +combineStats statsRef = do + threadStats' <- allTLS statsRef + threadStats <- mapM readIORef threadStats' :: IO [StatsMap] + let statsLists = map (Map.map mvToList) threadStats :: [Map EVM.Types.W256 (IO [StatsInfo])] + traverse (U.fromList <$>) $ Map.unionsWith zipSumStats statsLists + where + mvToList :: (VU.Unbox a) => VU.IOVector a -> IO [a] + mvToList = fmap U.toList . U.freeze saveCoverages :: Env @@ -42,7 +62,8 @@ saveCoverages saveCoverages env seed d sc cs = do let fileTypes = env.cfg.campaignConf.coverageFormats coverage <- readIORef env.coverageRef - mapM_ (\ty -> saveCoverage ty seed d sc cs coverage) fileTypes + stats <- combineStats env.statsRef + mapM_ (\ty -> saveCoverage ty seed d sc cs coverage stats) fileTypes saveCoverage :: CoverageFileType @@ -51,11 +72,12 @@ saveCoverage -> SourceCache -> [SolcContract] -> CoverageMap + -> StatsMapV -> IO () -saveCoverage fileType seed d sc cs covMap = do +saveCoverage fileType seed d sc cs covMap statMap = do let extension = coverageFileExtension fileType fn = d "covered." <> show seed <> extension - cc <- ppCoveredCode fileType sc cs covMap + cc <- ppCoveredCode fileType sc cs covMap statMap createDirectoryIfMissing True d writeFile fn cc @@ -65,11 +87,11 @@ 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" +ppCoveredCode :: CoverageFileType -> SourceCache -> [SolcContract] -> CoverageMap -> StatsMapV -> IO Text +ppCoveredCode fileType sc cs s sm | null s = pure "Coverage map is empty" | otherwise = do -- List of covered lines during the fuzzing campaign - covLines <- srcMapCov sc s cs + covLines <- srcMapCov sc s sm cs let -- Collect all the possible lines from all the files allFiles = (\(path, src) -> (path, V.fromList (decodeUtf8 <$> BS.split 0xa src))) <$> Map.elems sc.files @@ -97,13 +119,13 @@ ppCoveredCode fileType sc cs s | null s = pure "Coverage map is empty" -- ^ Alter file name, in the case of html turning it into bold text changeFileLines ls = case fileType of Lcov -> ls ++ ["end_of_record"] - Html -> "" : ls ++ ["", "","
"] + Html -> "
Legend: Line # | Execs # | Reverts # | Code
" : 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) -- | 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 +markLines :: CoverageFileType -> V.Vector Text -> S.Set Int -> Map Int ([TxResult], StatsInfo) -> V.Vector Text markLines fileType codeLines runtimeLines resultMap = V.map markLine . V.filter shouldUseLine $ V.indexed codeLines where @@ -112,7 +134,7 @@ markLines fileType codeLines runtimeLines resultMap = _ -> True markLine (i, codeLine) = let n = i + 1 - results = fromMaybe [] (Map.lookup n resultMap) + (results, (execs, reverts)) = fromMaybe ([], (0, 0)) (Map.lookup n resultMap) markers = sort $ nub $ getMarker <$> results wrapLine :: Text -> Text wrapLine line = case fileType of @@ -123,11 +145,16 @@ markLines fileType codeLines runtimeLines resultMap = where cssClass = if n `elem` runtimeLines then getCSSClass markers else "neutral" result = case fileType of - Lcov -> pack $ printf "DA:%d,%d" n (length results) - _ -> pack $ printf " %*d | %-4s| %s" lineNrSpan n markers (wrapLine codeLine) + Lcov -> pack $ printf "DA:%d,%d" n execs + Html -> pack $ printf "%*d | %4s | %4s | %-4s| %s" lineNrSpan n (prettyCount execs) (prettyCount reverts) markers (wrapLine codeLine) + _ -> pack $ printf "%*d | %-4s| %s" lineNrSpan n markers (wrapLine codeLine) in result lineNrSpan = length . show $ V.length codeLines + 1 + prettyCount x = prettyCount' x 0 + prettyCount' x n | x >= 1000 = prettyCount' (x `div` 1000) (n + 1) + | x < 1000 && n == 0 = show x + | otherwise = show x <> [" kMGTPEZY" !! n] getCSSClass :: String -> Text getCSSClass markers = @@ -146,11 +173,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 +srcMapCov :: SourceCache -> CoverageMap -> StatsMapV -> [SolcContract] -> IO (Map FilePath (Map Int ([TxResult], StatsInfo))) +srcMapCov sc covMap statMap contracts = do Map.unionsWith Map.union <$> mapM linesCovered contracts where - linesCovered :: SolcContract -> IO (Map FilePath (Map Int [TxResult])) + linesCovered :: SolcContract -> IO (Map FilePath (Map Int ([TxResult], StatsInfo))) linesCovered c = case Map.lookup c.runtimeCodehash covMap of Just vec -> VU.foldl' (\acc covInfo -> case covInfo of @@ -167,8 +194,13 @@ srcMapCov sc covMap contracts = do where innerUpdate = Map.alter - (Just . (<> unpackTxResults txResults) . fromMaybe mempty) + updateLine line + updateLine (Just (r, s)) = Just ((<> unpackTxResults txResults) r, maxStats s idxStats) + updateLine Nothing = Just (unpackTxResults txResults, idxStats) + fileStats = Map.lookup c.runtimeCodehash statMap + idxStats = maybe (0, 0) (U.! opIx) fileStats + maxStats (a1, b1) (a2, b2) = (max a1 a2, max b1 b2) Nothing -> acc Nothing -> acc ) mempty vec diff --git a/lib/Echidna/Types/Config.hs b/lib/Echidna/Types/Config.hs index 62f4e7513..18253b542 100644 --- a/lib/Echidna/Types/Config.hs +++ b/lib/Echidna/Types/Config.hs @@ -8,6 +8,7 @@ import Data.Set (Set) import Data.Text (Text) import Data.Time (LocalTime) import Data.Word (Word64) +import Data.TLS.GHC import EVM.Dapp (DappInfo) import EVM.Types (Addr, Contract, W256) @@ -15,7 +16,7 @@ import EVM.Types (Addr, Contract, W256) import Echidna.SourceMapping (CodehashMap) import Echidna.Types.Campaign (CampaignConf, CampaignEvent) import Echidna.Types.Corpus (Corpus) -import Echidna.Types.Coverage (CoverageMap) +import Echidna.Types.Coverage (CoverageMap, StatsMap) import Echidna.Types.Solidity (SolConf) import Echidna.Types.Test (TestConf, EchidnaTest) import Echidna.Types.Tx (TxConf) @@ -71,6 +72,7 @@ data Env = Env , testRefs :: [IORef EchidnaTest] , coverageRef :: IORef CoverageMap + , statsRef :: TLS (IORef StatsMap) , corpusRef :: IORef Corpus , codehashMap :: CodehashMap diff --git a/lib/Echidna/Types/Coverage.hs b/lib/Echidna/Types/Coverage.hs index 8d1241172..ddee59c35 100644 --- a/lib/Echidna/Types/Coverage.hs +++ b/lib/Echidna/Types/Coverage.hs @@ -6,6 +6,7 @@ import Data.List (foldl') import Data.Map qualified as Map import Data.Map.Strict (Map) import Data.Text (toLower) +import Data.Vector.Unboxed (Vector) import Data.Vector.Unboxed.Mutable (IOVector) import Data.Vector.Unboxed.Mutable qualified as V import Data.Word (Word64) @@ -17,9 +18,23 @@ import Echidna.Types.Tx (TxResult) -- Indexed by contracts' compile-time codehash; see `CodehashMap`. type CoverageMap = Map W256 (IOVector CoverageInfo) +-- | Map with the statistic information needed for source code printing. +-- Indexed by contracts' compile-time codehash; see `CodehashMap`. +-- Used during runtime data collection +type StatsMap = Map W256 (IOVector StatsInfo) + +-- | Map with the statistic information needed for source code printing. +-- Indexed by contracts' compile-time codehash; see `CodehashMap`. +-- Used during statistics summarization (combining multiple `StatsMap`) +-- and coverage report generation. +type StatsMapV = Map W256 (Vector StatsInfo) + -- | Basic coverage information type CoverageInfo = (OpIx, StackDepths, TxResults) +-- | Basic stats information +type StatsInfo = (ExecQty, RevertQty) + -- | Index per operation in the source code, obtained from the source mapping type OpIx = Int @@ -29,6 +44,12 @@ type StackDepths = Word64 -- | Packed TxResults used for coverage, corresponding bits are set type TxResults = Word64 +-- | Hit count +type ExecQty = Word64 + +-- | Revert count +type RevertQty = Word64 + -- | 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 diff --git a/package.yaml b/package.yaml index b6732053a..7c5c01a04 100644 --- a/package.yaml +++ b/package.yaml @@ -67,6 +67,7 @@ library: - signal - split - strip-ansi-escape + - thread-local-storage - time - unliftio - utf8-string