Skip to content

Commit

Permalink
Shrink on one worker
Browse files Browse the repository at this point in the history
  • Loading branch information
arcz committed Jun 27, 2024
1 parent 882c699 commit c6bb0e7
Show file tree
Hide file tree
Showing 15 changed files with 313 additions and 245 deletions.
64 changes: 33 additions & 31 deletions lib/Echidna.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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:
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 []
Expand All @@ -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
}
Loading

0 comments on commit c6bb0e7

Please sign in to comment.