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
  }