From 1ec4e894d1ab59719bce30f3171725403ffe6c72 Mon Sep 17 00:00:00 2001 From: Artur Cygan Date: Tue, 18 Jul 2023 15:39:35 +0200 Subject: [PATCH] Bring back loading multiple combined JSON files --- lib/Echidna/Solidity.hs | 75 +++++++++++++++++------------------ lib/Echidna/Types/Solidity.hs | 6 --- src/Main.hs | 14 +++---- src/test/Common.hs | 9 +++-- 4 files changed, 47 insertions(+), 57 deletions(-) diff --git a/lib/Echidna/Solidity.hs b/lib/Echidna/Solidity.hs index 3abae02ad..3cb9af09d 100644 --- a/lib/Echidna/Solidity.hs +++ b/lib/Echidna/Solidity.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} - module Echidna.Solidity where import Optics.Core hiding (filtered) @@ -52,34 +50,34 @@ import Echidna.Types.Tx import Echidna.Types.World (World(..)) import Echidna.Utility (measureIO) --- | Given a list of source caches (SourceCaches) and an optional contract name, --- select one that includes that contract (if possible). Otherwise, use the first source --- cache available (or fail if it is empty) -selectSourceCache :: Maybe ContractName -> SourceCaches -> SourceCache -selectSourceCache (Just c) scs = +-- | Given a list of build outputs and an optional contract name, select one +-- that includes that contract (if possible). Otherwise, use the first build +-- output available (or fail if it is empty) +selectBuildOutput :: Maybe ContractName -> [BuildOutput] -> BuildOutput +selectBuildOutput (Just c) buildOutputs = let - r = concatMap (\(cs,sc) -> - [sc | isJust $ find (Data.Text.isSuffixOf (":" <> c)) cs] - ) scs + r = concatMap (\buildOutput@(BuildOutput (Contracts contracts) _) -> + [buildOutput | isJust $ find (Data.Text.isSuffixOf (":" <> c)) (Map.keys contracts)] + ) buildOutputs in case r of - (sc:_) -> sc - _ -> error "Source cache selection returned no result" + (buildOutput:_) -> buildOutput + _ -> error "Build output selection returned no result" -selectSourceCache _ scs = +selectBuildOutput _ scs = case scs of - (_,sc):_ -> sc - _ -> error "Empty source cache" + sc:_ -> sc + _ -> error "Empty source cache" -readSolcBatch :: FilePath -> IO (Maybe BuildOutput) +readSolcBatch :: FilePath -> IO [BuildOutput] readSolcBatch d = do - fs <- listDirectory d - case fs of - [f] -> - readSolc CombinedJSON "" (d f) >>= \case - Right buildOutput -> pure $ Just buildOutput - Left e -> - error $ "Failed to parse combined JSON file " <> (d f) <> "\n" <> e - _ -> error "too many files" + fs <- filter (".json" `Data.List.isSuffixOf`) <$> listDirectory d + mapM parseOne fs + where + parseOne f = + readSolc CombinedJSON "" (d f) >>= \case + Right buildOutput -> pure buildOutput + Left e -> + error $ "Failed to parse combined JSON file " <> (d f) <> "\n" <> e -- | Given a list of files, use its extenstion to check if it is a precompiled -- contract or try to compile it and get a list of its contracts and a list of source @@ -87,7 +85,7 @@ readSolcBatch d = do compileContracts :: SolConf -> NonEmpty FilePath - -> IO BuildOutput + -> IO [BuildOutput] compileContracts solConf fp = do path <- findExecutable "crytic-compile" >>= \case Nothing -> throwM NoCryticCompile @@ -97,20 +95,18 @@ compileContracts solConf fp = do usual = ["--solc-disable-warnings", "--export-format", "solc"] solargs = solConf.solcArgs ++ linkLibraries solConf.solcLibs & (usual ++) . (\sa -> if null sa then [] else ["--solc-args", sa]) - compileOne :: FilePath -> IO BuildOutput + compileOne :: FilePath -> IO [BuildOutput] compileOne x = do - mSolc <- do - stderr <- if solConf.quiet - then UseHandle <$> openFile nullFilePath WriteMode - else pure Inherit - (ec, out, err) <- measureIO solConf.quiet ("Compiling " <> x) $ do - readCreateProcessWithExitCode - (proc path $ (solConf.cryticArgs ++ solargs) |> x) {std_err = stderr} "" - case ec of - ExitSuccess -> readSolcBatch "crytic-export" - ExitFailure _ -> throwM $ CompileFailure out err - - maybe (throwM SolcReadFailure) pure mSolc + stderr <- if solConf.quiet + then UseHandle <$> openFile nullFilePath WriteMode + else pure Inherit + (ec, out, err) <- measureIO solConf.quiet ("Compiling " <> x) $ do + readCreateProcessWithExitCode + (proc path $ (solConf.cryticArgs ++ solargs) |> x) {std_err = stderr} "" + case ec of + ExitSuccess -> readSolcBatch "crytic-export" + ExitFailure _ -> throwM $ CompileFailure out err + -- | OS-specific path to the "null" file, which accepts writes without storing them nullFilePath :: String nullFilePath = if os == "mingw32" then "\\\\.\\NUL" else "/dev/null" @@ -368,7 +364,8 @@ loadSolTests -> IO (VM, World, [EchidnaTest]) loadSolTests env fp name = do let solConf = env.cfg.solConf - BuildOutput{contracts = Contracts (Map.elems -> contracts)} <- compileContracts solConf fp + buildOutputs <- compileContracts solConf fp + let contracts = Map.elems . Map.unions $ (\(BuildOutput (Contracts c) _) -> c) <$> buildOutputs (vm, funs, testNames, _signatureMap) <- loadSpecified env name contracts let eventMap = Map.unions $ map (.eventMap) contracts diff --git a/lib/Echidna/Types/Solidity.hs b/lib/Echidna/Types/Solidity.hs index dec1c8739..74a606e0c 100644 --- a/lib/Echidna/Types/Solidity.hs +++ b/lib/Echidna/Types/Solidity.hs @@ -5,11 +5,8 @@ import Data.SemVer (Version, version, toString) import Data.Set (Set) import Data.Text (Text, unpack) -import EVM.Solidity import EVM.Types (Addr) -import Echidna.Types.Signature (ContractName) - minSupportedSolcVersion :: Version minSupportedSolcVersion = version 0 4 25 [] [] @@ -80,9 +77,6 @@ data SolConf = SolConf , methodFilter :: Filter -- ^ List of methods to avoid or include calling during a campaign } --- | List of contract names from every source cache -type SourceCaches = [([ContractName], SourceCache)] - defaultContractAddr :: Addr defaultContractAddr = 0x00a329c0648769a73afac7f9381e08fb43dbea72 diff --git a/src/Main.hs b/src/Main.hs index d8427d199..9eef594c8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} module Main where @@ -37,7 +36,7 @@ import System.IO.CodePage (withCP65001) import EVM (bytecode) import EVM.Dapp (dappInfo) -import EVM.Solidity (SolcContract(..), SourceCache(..), BuildOutput(..), Contracts (Contracts)) +import EVM.Solidity (SolcContract(..), SourceCache(..), BuildOutput(..), Contracts(..)) import EVM.Types (Addr, Contract(..), keccak', W256) import Echidna @@ -53,7 +52,7 @@ import Echidna.UI import Echidna.Output.Source import Echidna.Output.Corpus import Echidna.RPC qualified as RPC -import Echidna.Solidity (compileContracts) +import Echidna.Solidity (compileContracts, selectBuildOutput) import Echidna.Utility (measureIO) import Etherscan qualified @@ -87,7 +86,7 @@ main = withUtf8 $ withCP65001 $ do Nothing -> pure (Nothing, Nothing) - buildOutput <- compileContracts cfg.solConf cliFilePath + buildOutputs <- compileContracts cfg.solConf cliFilePath cacheContractsRef <- newIORef $ fromMaybe mempty loadedContractsCache cacheSlotsRef <- newIORef $ fromMaybe mempty loadedSlotsCache cacheMetaRef <- newIORef mempty @@ -98,9 +97,8 @@ main = withUtf8 $ withCP65001 $ do testsRef <- newIORef mempty let - BuildOutput{ sources = sourceCache - , contracts = Contracts (Map.elems -> contracts) - } = buildOutput + contracts = Map.elems . Map.unions $ (\(BuildOutput (Contracts c) _) -> c) <$> buildOutputs + buildOutput = selectBuildOutput cliSelectedContract buildOutputs env = Env { cfg -- TODO put in real path , dapp = dappInfo "/" buildOutput @@ -175,7 +173,7 @@ main = withUtf8 $ withCP65001 $ do Nothing -> pure () -- save source coverage reports - saveCoverages cfg.campaignConf.coverageFormats runId dir sourceCache contracts coverage + saveCoverages cfg.campaignConf.coverageFormats runId dir buildOutput.sources contracts coverage if isSuccessful tests then exitSuccess else exitWith (ExitFailure 1) diff --git a/src/test/Common.hs b/src/test/Common.hs index a69013c15..6b3a022f8 100644 --- a/src/test/Common.hs +++ b/src/test/Common.hs @@ -41,7 +41,7 @@ import System.Process (readProcess) import Echidna (prepareContract) import Echidna.Config (parseConfig, defaultConfig) import Echidna.Campaign (runWorker) -import Echidna.Solidity (loadSolTests, compileContracts) +import Echidna.Solidity (loadSolTests, compileContracts, selectBuildOutput) import Echidna.Test (checkETest) import Echidna.Types (Gas) import Echidna.Types.Config (Env(..), EConfig(..), EConfigWithUsage(..)) @@ -92,9 +92,10 @@ withSolcVersion (Just f) t = do runContract :: FilePath -> Maybe ContractName -> EConfig -> IO (Env, WorkerState) runContract f selectedContract cfg = do seed <- maybe (getRandomR (0, maxBound)) pure cfg.campaignConf.seed - buildOutput <- compileContracts cfg.solConf (f :| []) - let BuildOutput{contracts = Contracts cs} = buildOutput - let contracts = Map.elems cs + buildOutputs <- compileContracts cfg.solConf (f :| []) + let + buildOutput = selectBuildOutput selectedContract buildOutputs + contracts = Map.elems . Map.unions $ (\(BuildOutput (Contracts c) _) -> c) <$> buildOutputs metadataCache <- newIORef mempty fetchContractCache <- newIORef mempty