Shrink on one worker

lib/Echidna.hs

@@ -3,7 +3,7 @@ module Echidna where
 import Control.Concurrent (newChan)
 import Control.Monad.Catch (MonadThrow(..))
 import Control.Monad.ST (RealWorld)
-import Data.IORef (writeIORef, newIORef)
+import Data.IORef (newIORef)
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
@@ -13,25 +13,26 @@ import System.FilePath ((</>))
 
 import EVM (cheatCode)
 import EVM.ABI (AbiValue(AbiAddress))
-import EVM.Dapp (DappInfo(..), dappInfo)
+import EVM.Dapp (dappInfo)
 import EVM.Fetch qualified
-import EVM.Solidity (BuildOutput)
+import EVM.Solidity (BuildOutput(..), Contracts(Contracts))
 import EVM.Types hiding (Env)
 
 import Echidna.ABI
 import Echidna.Etheno (loadEtheno, extractFromEtheno)
+import Echidna.Onchain as Onchain
 import Echidna.Output.Corpus
 import Echidna.SourceAnalysis.Slither
 import Echidna.Solidity
 import Echidna.Symbolic (forceAddr)
-import Echidna.Test (createTests)
 import Echidna.Types.Campaign
 import Echidna.Types.Config
 import Echidna.Types.Random
-import Echidna.Types.Signature
 import Echidna.Types.Solidity
 import Echidna.Types.Tx
 import Echidna.Types.World
+import Echidna.Types.Test (EchidnaTest)
+import Echidna.Types.Signature (ContractName)
 
 -- | This function is used to prepare, process, compile and initialize smart contracts for testing.
 -- It takes:
@@ -45,17 +46,20 @@ import Echidna.Types.World
 -- * A list of Echidna tests to check
 -- * A prepopulated dictionary
 prepareContract
-  :: Env
+  :: EConfig
   -> NonEmpty FilePath
+  -> BuildOutput
   -> Maybe ContractName
   -> Seed
-  -> IO (VM Concrete RealWorld, World, GenDict)
-prepareContract env solFiles specifiedContract seed = do
-  let solConf = env.cfg.solConf
-      contracts = Map.elems env.dapp.solcByName
+  -> IO (VM Concrete RealWorld, Env, GenDict)
+prepareContract cfg solFiles buildOutput selectedContract seed = do
+  let solConf = cfg.solConf
+      (Contracts contractMap) = buildOutput.contracts
+      contracts = Map.elems contractMap
 
-  -- deploy contracts
-  (vm, funs, testNames, signatureMap) <- loadSpecified env specifiedContract contracts
+  mainContract <- selectMainContract solConf selectedContract contracts
+  tests <- mkTests solConf mainContract
+  signatureMap <- mkSignatureMap solConf mainContract contracts
 
   -- run processors
   slitherInfo <- runSlither (NE.head solFiles) solConf
@@ -64,16 +68,14 @@ prepareContract env solFiles specifiedContract seed = do
     Just version                              -> throwM $ OutdatedSolcVersion version
     Nothing -> pure ()
 
-  let
-    -- load tests
-    echidnaTests = createTests solConf.testMode
-                               solConf.testDestruction
-                               testNames
-                               (forceAddr vm.state.contract)
-                               funs
+  let world = mkWorld cfg.solConf signatureMap selectedContract slitherInfo contracts
 
-    world = mkWorld solConf signatureMap specifiedContract slitherInfo contracts
+  env <- mkEnv cfg buildOutput tests world
 
+  -- deploy contracts
+  vm <- loadSpecified env mainContract contracts
+
+  let
     deployedAddresses = Set.fromList $ AbiAddress . forceAddr <$> Map.keys vm.env.contracts
     constants = enhanceConstants slitherInfo
                 <> timeConstants
@@ -88,13 +90,12 @@ prepareContract env solFiles specifiedContract seed = do
                      seed
                      (returnTypes contracts)
 
-  writeIORef env.testsRef echidnaTests
-  pure (vm, world, dict)
+  pure (vm, env, dict)
 
-loadInitialCorpus :: Env -> World -> IO [(FilePath, [Tx])]
-loadInitialCorpus env world = do
+loadInitialCorpus :: Env -> IO [(FilePath, [Tx])]
+loadInitialCorpus env = do
   -- load transactions from init sequence (if any)
-  let sigs = Set.fromList $ concatMap NE.toList (Map.elems world.highSignatureMap)
+  let sigs = Set.fromList $ concatMap NE.toList (Map.elems env.world.highSignatureMap)
   ethenoCorpus <-
     case env.cfg.solConf.initialize of
       Nothing -> pure []
@@ -112,18 +113,19 @@ loadInitialCorpus env world = do
 
   pure $ persistedCorpus ++ ethenoCorpus
 
-mkEnv :: EConfig -> BuildOutput -> IO Env
-mkEnv cfg buildOutput = do
-  fetchContractCache <- newIORef mempty
-  fetchSlotCache <- newIORef mempty
+mkEnv :: EConfig -> BuildOutput -> [EchidnaTest] -> World -> IO Env
+mkEnv cfg buildOutput tests world = do
   codehashMap <- newIORef mempty
   chainId <- maybe (pure Nothing) EVM.Fetch.fetchChainIdFrom cfg.rpcUrl
   eventQueue <- newChan
   coverageRef <- newIORef mempty
   corpusRef <- newIORef mempty
-  testsRef <- newIORef mempty
+  testRefs <- traverse newIORef tests
+  (contractCache, slotCache) <- Onchain.loadRpcCache cfg
+  fetchContractCache <- newIORef contractCache
+  fetchSlotCache <- newIORef slotCache
   -- TODO put in real path
   let dapp = dappInfo "/" buildOutput
   pure $ Env { cfg, dapp, codehashMap, fetchContractCache, fetchSlotCache
-             , chainId, eventQueue, coverageRef, corpusRef, testsRef
+             , chainId, eventQueue, coverageRef, corpusRef, testRefs, world
              }