Refactor BuildOutput (#1174)

lib/Echidna.hs

@@ -12,6 +12,7 @@ import System.FilePath ((</>))
 
 import EVM (cheatCode)
 import EVM.ABI (AbiValue(AbiAddress))
+import EVM.Dapp (DappInfo(..))
 import EVM.Solidity (SolcContract(..))
 import EVM.Types hiding (Env)
 
@@ -43,13 +44,13 @@ import Echidna.Types.World
 -- * A prepopulated dictionary
 prepareContract
   :: Env
-  -> [SolcContract]
   -> NonEmpty FilePath
   -> Maybe ContractName
   -> Seed
   -> IO (VM RealWorld, World, GenDict)
-prepareContract env contracts solFiles specifiedContract seed = do
+prepareContract env solFiles specifiedContract seed = do
   let solConf = env.cfg.solConf
+      contracts = Map.elems env.dapp.solcByName
 
   -- compile and load contracts
   (vm, funs, testNames, signatureMap) <- loadSpecified env specifiedContract contracts

lib/Echidna/Solidity.hs

@@ -53,24 +53,6 @@ import Echidna.Types.Tx
 import Echidna.Types.World (World(..))
 import Echidna.Utility (measureIO)
 
--- | 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 (\buildOutput@(BuildOutput (Contracts contracts) _) ->
-          [buildOutput | isJust $ find (Data.Text.isSuffixOf (":" <> c)) (Map.keys contracts)]
-        ) buildOutputs
-  in case r of
-    (buildOutput:_) -> buildOutput
-    _ -> error "Build output selection returned no result"
-
-selectBuildOutput _ scs =
-  case scs of
-    sc:_ -> sc
-    _    -> error "Empty source cache"
-
 readSolcBatch :: FilePath -> IO [BuildOutput]
 readSolcBatch d = do
   fs <- filter (".json" `Data.List.isSuffixOf`) <$> listDirectory d
@@ -88,7 +70,7 @@ readSolcBatch d = do
 compileContracts
   :: SolConf
   -> NonEmpty FilePath
-  -> IO [BuildOutput]
+  -> IO BuildOutput
 compileContracts solConf fp = do
   path <- findExecutable "crytic-compile" >>= \case
     Nothing -> throwM NoCryticCompile
@@ -98,7 +80,7 @@ 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
       stderr <- if solConf.quiet
                    then UseHandle <$> openFile nullFilePath WriteMode
@@ -107,19 +89,15 @@ compileContracts solConf fp = do
         readCreateProcessWithExitCode
           (proc path $ (solConf.cryticArgs ++ solargs) |> x) {std_err = stderr} ""
       case ec of
-        ExitSuccess -> readSolcBatch "crytic-export"
+        ExitSuccess -> mconcat <$> 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"
   -- clean up previous artifacts
   removeJsonFiles "crytic-export"
-  buildOutputs <- mapM compileOne fp
-  when (length buildOutputs > 1) $
-    putStrLn "WARNING: more than one SourceCaches was found after compile. \
-             \Only the first one will be used."
-  pure $ NE.head buildOutputs
+  mconcat . NE.toList <$> mapM compileOne fp
 
 removeJsonFiles :: FilePath -> IO ()
 removeJsonFiles dir =
@@ -384,8 +362,8 @@ loadSolTests
   -> IO (VM RealWorld, World, [EchidnaTest])
 loadSolTests env fp name = do
   let solConf = env.cfg.solConf
-  buildOutputs <- compileContracts solConf fp
-  let contracts = Map.elems . Map.unions $ (\(BuildOutput (Contracts c) _) -> c) <$> buildOutputs
+  buildOutput <- compileContracts solConf fp
+  let contracts = Map.elems . (\(BuildOutput (Contracts c) _) -> c) $ buildOutput
   (vm, funs, testNames, _signatureMap) <- loadSpecified env name contracts
   let
     eventMap = Map.unions $ map (.eventMap) contracts

src/Main.hs

@@ -35,8 +35,8 @@ import System.IO (hPutStrLn, stderr)
 import System.IO.CodePage (withCP65001)
 
 import EVM (bytecode)
-import EVM.Dapp (dappInfo)
-import EVM.Solidity (SolcContract(..), SourceCache(..), BuildOutput(..), Contracts(..))
+import EVM.Dapp (DappInfo(..), dappInfo)
+import EVM.Solidity (SolcContract(..), SourceCache(..), BuildOutput(..))
 import EVM.Types (Addr, Contract(..), keccak', W256)
 
 import Echidna
@@ -52,7 +52,7 @@ import Echidna.UI
 import Echidna.Output.Source
 import Echidna.Output.Corpus
 import Echidna.RPC qualified as RPC
-import Echidna.Solidity (compileContracts, selectBuildOutput)
+import Echidna.Solidity (compileContracts)
 import Echidna.Utility (measureIO)
 import Etherscan qualified
 
@@ -86,7 +86,7 @@ main = withUtf8 $ withCP65001 $ do
           Nothing ->
             pure (Nothing, Nothing)
 
-  buildOutputs <- compileContracts cfg.solConf cliFilePath
+  buildOutput <- compileContracts cfg.solConf cliFilePath
   cacheContractsRef <- newIORef $ fromMaybe mempty loadedContractsCache
   cacheSlotsRef <- newIORef $ fromMaybe mempty loadedSlotsCache
   codehashMap <- newIORef mempty
@@ -97,11 +97,10 @@ main = withUtf8 $ withCP65001 $ do
   testsRef <- newIORef mempty
 
   let
-    contracts = Map.elems . Map.unions $ (\(BuildOutput (Contracts c) _) -> c) <$> buildOutputs
-    buildOutput = selectBuildOutput cliSelectedContract buildOutputs
+    -- TODO put in real path
+    dapp = dappInfo "/" buildOutput
     env = Env { cfg
-                -- TODO put in real path
-              , dapp = dappInfo "/" buildOutput
+              , dapp
               , codehashMap = codehashMap
               , fetchContractCache = cacheContractsRef
               , fetchSlotCache = cacheSlotsRef
@@ -114,8 +113,7 @@ main = withUtf8 $ withCP65001 $ do
 
   -- take the seed from config, otherwise generate a new one
   seed <- maybe (getRandomR (0, maxBound)) pure cfg.campaignConf.seed
-  (vm, world, dict) <-
-    prepareContract env contracts cliFilePath cliSelectedContract seed
+  (vm, world, dict) <- prepareContract env cliFilePath cliSelectedContract seed
 
   initialCorpus <- loadInitialCorpus env world
   -- start ui and run tests
@@ -173,6 +171,7 @@ main = withUtf8 $ withCP65001 $ do
               Nothing -> pure ()
 
         -- save source coverage reports
+        let contracts = Map.elems dapp.solcByName
         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, selectBuildOutput)
+import Echidna.Solidity (loadSolTests, compileContracts)
 import Echidna.Test (checkETest)
 import Echidna.Types (Gas)
 import Echidna.Types.Config (Env(..), EConfig(..), EConfigWithUsage(..))
@@ -52,7 +52,6 @@ import Echidna.Types.Test
 import Echidna.Types.Tx (Tx(..), TxCall(..), call)
 
 import EVM.Dapp (dappInfo, emptyDapp)
-import EVM.Solidity (BuildOutput(..), Contracts (Contracts))
 import Control.Concurrent (newChan)
 import Control.Monad (forM_)
 
@@ -92,10 +91,7 @@ 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
-  buildOutputs <- compileContracts cfg.solConf (f :| [])
-  let
-    buildOutput = selectBuildOutput selectedContract buildOutputs
-    contracts = Map.elems . Map.unions $ (\(BuildOutput (Contracts c) _) -> c) <$> buildOutputs
+  buildOutput <- compileContracts cfg.solConf (f :| [])
 
   codehashMap <- newIORef mempty
   fetchContractCache <- newIORef mempty
@@ -114,7 +110,7 @@ runContract f selectedContract cfg = do
                 , eventQueue
                 , testsRef
                 , chainId = Nothing }
-  (vm, world, dict) <- prepareContract env contracts (f :| []) selectedContract seed
+  (vm, world, dict) <- prepareContract env (f :| []) selectedContract seed
 
   let corpus = []
   (_stopReason, finalState) <- flip runReaderT env $