Skip to content

Commit

Permalink
Bring back loading multiple combined JSON files (#1098)
Browse files Browse the repository at this point in the history
  • Loading branch information
arcz authored Jul 18, 2023
1 parent f4dfed2 commit 7be4072
Show file tree
Hide file tree
Showing 4 changed files with 47 additions and 57 deletions.
75 changes: 36 additions & 39 deletions lib/Echidna/Solidity.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
{-# LANGUAGE ViewPatterns #-}

module Echidna.Solidity where

import Optics.Core hiding (filtered)
Expand Down Expand Up @@ -52,42 +50,42 @@ 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
-- cache, throwing exceptions if necessary.
compileContracts
:: SolConf
-> NonEmpty FilePath
-> IO BuildOutput
-> IO [BuildOutput]
compileContracts solConf fp = do
path <- findExecutable "crytic-compile" >>= \case
Nothing -> throwM NoCryticCompile
Expand All @@ -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"
Expand Down Expand Up @@ -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
Expand Down
6 changes: 0 additions & 6 deletions lib/Echidna/Types/Solidity.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 [] []

Expand Down Expand Up @@ -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

Expand Down
14 changes: 6 additions & 8 deletions src/Main.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)

Expand Down
9 changes: 5 additions & 4 deletions src/test/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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(..))
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 7be4072

Please sign in to comment.