Bring back loading multiple combined JSON files (#1098)

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

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
 

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)
 

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