Cleanup some code and improve naming

pull/927/head
Artur Cygan 2 years ago
parent 8d88edf274
commit 8fbf924f86
  1. 88
      lib/Echidna.hs
  2. 7
      lib/Echidna/Processor.hs
  3. 6
      lib/Echidna/RPC.hs
  4. 78
      lib/Echidna/Solidity.hs
  5. 29
      src/Main.hs
  6. 5
      src/test/Common.hs
  7. 4
      src/test/Tests/Compile.hs

@ -8,23 +8,24 @@ import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import System.FilePath ((</>))
import EVM hiding (Env, env)
import EVM hiding (Env, env, contracts)
import EVM.ABI (AbiValue(AbiAddress))
import EVM.Solidity (SourceCache, SolcContract)
import EVM.Solidity (SourceCache, SolcContract(..))
import Echidna.ABI
import Echidna.Output.Corpus
import Echidna.Processor
import Echidna.RPC (loadEtheno, extractFromEtheno)
import Echidna.Solidity
import Echidna.Test (createTests)
import Echidna.Types.Campaign hiding (corpus)
import Echidna.Types.Config
import Echidna.Types.Solidity
import Echidna.Types.Campaign
import Echidna.Types.Random
import Echidna.Types.Signature
import Echidna.Types.Solidity
import Echidna.Types.Test
import Echidna.Types.Tx
import Echidna.Types.World
import Echidna.Solidity
import Echidna.Processor
import Echidna.Output.Corpus
import Echidna.RPC (loadEtheno, extractFromEtheno)
-- | This function is used to prepare, process, compile and initialize smart contracts for testing.
-- It takes:
@ -37,44 +38,51 @@ import Echidna.RPC (loadEtheno, extractFromEtheno)
-- * A World with all the required data for generating random transctions
-- * A list of Echidna tests to check
-- * A prepopulated dictionary
-- * A list of transaction sequences to initialize the corpus
prepareContract :: Env -> NE.NonEmpty FilePath -> Maybe ContractName -> Seed
-> IO (VM, SourceCache, [SolcContract], World, [EchidnaTest], GenDict, [[Tx]])
prepareContract env fs c g = do
ctxs <- case env.cfg.campaignConf.corpusDir of
Nothing -> pure []
Just dir -> do
ctxs1 <- loadTxs (dir </> "reproducers")
ctxs2 <- loadTxs (dir </> "coverage")
pure (ctxs1 ++ ctxs2)
-> IO (VM, SourceCache, [SolcContract], World, [EchidnaTest], GenDict)
prepareContract env solFiles specifiedContract seed = do
let solConf = env.cfg.solConf
-- compile and load contracts
(cs, scs) <- Echidna.Solidity.contracts solConf fs
p <- loadSpecified env c cs
(contracts, scs) <- compileContracts solConf solFiles
(vm, funs, testNames, signatureMap) <- loadSpecified env specifiedContract contracts
-- run processors
si <- runSlither (NE.head fs) solConf.cryticArgs
case find (< minSupportedSolcVersion) si.solcVersions of
slitherInfo <- runSlither (NE.head solFiles) solConf.cryticArgs
case find (< minSupportedSolcVersion) slitherInfo.solcVersions of
Just outdatedVersion -> throwM $ OutdatedSolcVersion outdatedVersion
Nothing -> return ()
Nothing -> pure ()
-- load tests
let (vm, world, ts) = prepareForTest solConf p c si
let echidnaTests = createTests
solConf.testMode
solConf.testDestruction
testNames
vm._state._contract
funs
-- get signatures
let sigs = Set.fromList $ concatMap NE.toList (HM.elems world.highSignatureMap)
let eventMap = Map.unions $ map (.eventMap) contracts
let world = mkWorld solConf eventMap signatureMap specifiedContract slitherInfo
let deployedAddresses = Set.fromList $ AbiAddress <$> Map.keys vm._env._contracts
let constants = enhanceConstants slitherInfo
<> timeConstants
<> extremeConstants
<> staticAddresses solConf
<> deployedAddresses
let ads = addresses solConf
let ads' = AbiAddress <$> Map.keys vm._env._contracts
let constants' = Set.fromList $ enhanceConstants si ++
timeConstants ++
extremeConstants ++
Set.toList ads ++
ads'
let dict = mkGenDict env.cfg.campaignConf.dictFreq
constants
Set.empty
seed
(returnTypes contracts)
pure (vm, selectSourceCache specifiedContract scs, contracts, world, echidnaTests, dict)
prepareCorpus :: Env -> World -> IO [[Tx]]
prepareCorpus env world = do
-- load transactions from init sequence (if any)
let sigs = Set.fromList $ concatMap NE.toList (HM.elems world.highSignatureMap)
ethenoCorpus <-
case env.cfg.solConf.initialize of
Nothing -> pure []
@ -82,10 +90,12 @@ prepareContract env fs c g = do
es' <- loadEtheno fp
pure [extractFromEtheno es' sigs]
let corp = ctxs ++ ethenoCorpus
let sc = selectSourceCache c scs
let dict = mkGenDict env.cfg.campaignConf.dictFreq constants' Set.empty g (returnTypes cs)
persistedCorpus <-
case env.cfg.campaignConf.corpusDir of
Nothing -> pure []
Just dir -> do
ctxs1 <- loadTxs (dir </> "reproducers")
ctxs2 <- loadTxs (dir </> "coverage")
pure (ctxs1 ++ ctxs2)
pure (vm, sc, cs, world, ts, dict, corp)
pure $ persistedCorpus ++ ethenoCorpus

@ -9,13 +9,14 @@ import Data.Aeson.Types (FromJSON, Parser, Value(String))
import Data.ByteString.Base16 qualified as BS16 (decode)
import Data.ByteString.Lazy.Char8 qualified as BSL
import Data.ByteString.UTF8 qualified as BSU
import Data.Containers.ListUtils (nubOrd)
import Data.Either (fromRight)
import Data.HashMap.Strict qualified as M
import Data.List (isPrefixOf)
import Data.List.NonEmpty qualified as NE
import Data.Maybe (catMaybes, fromMaybe)
import Data.SemVer (Version, fromText)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (pack, isSuffixOf)
import System.Directory (findExecutable)
import System.Process (StdStream(..), readCreateProcessWithExitCode, proc, std_err)
@ -49,9 +50,9 @@ filterResults (Just c) rs =
Just s -> hashSig <$> s
filterResults Nothing rs = hashSig <$> (concat . M.elems) rs
enhanceConstants :: SlitherInfo -> [AbiValue]
enhanceConstants :: SlitherInfo -> Set AbiValue
enhanceConstants si =
nubOrd . concatMap enh . concat . concat . M.elems $ M.elems <$> si.constantValues
Set.fromList . concatMap enh . concat . concat . M.elems $ M.elems <$> si.constantValues
where
enh (AbiUInt _ n) = makeNumAbiValues (fromIntegral n)
enh (AbiInt _ n) = makeNumAbiValues (fromIntegral n)

@ -90,8 +90,10 @@ loadEtheno fp = do
extractFromEtheno :: [Etheno] -> Set SolSignature -> [Tx]
extractFromEtheno ess ss = case ess of
(BlockMined ni ti :es) -> Tx NoCall 0 0 0 0 0 (fromInteger ti, fromInteger ni) : extractFromEtheno es ss
(c@FunctionCall{} :es) -> concatMap (`matchSignatureAndCreateTx` c) ss ++ extractFromEtheno es ss
(BlockMined ni ti :es) ->
Tx NoCall 0 0 0 0 0 (fromInteger ti, fromInteger ni) : extractFromEtheno es ss
(c@FunctionCall{} :es) ->
concatMap (`matchSignatureAndCreateTx` c) ss ++ extractFromEtheno es ss
(_:es) -> extractFromEtheno es ss
_ -> []

@ -73,8 +73,9 @@ readSolcBatch d = do
-- | 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 cache, throwing
-- exceptions if necessary.
contracts :: SolConf -> NE.NonEmpty FilePath -> IO ([SolcContract], SourceCaches)
contracts solConf fp = let usual = ["--solc-disable-warnings", "--export-format", "solc"] in do
compileContracts :: SolConf -> NE.NonEmpty FilePath -> IO ([SolcContract], SourceCaches)
compileContracts solConf fp = do
let usual = ["--solc-disable-warnings", "--export-format", "solc"]
mp <- findExecutable "crytic-compile"
case mp of
Nothing -> throwM NoCryticCompile
@ -84,8 +85,11 @@ contracts solConf fp = let usual = ["--solc-disable-warnings", "--export-format"
compileOne :: FilePath -> IO ([SolcContract], SourceCaches)
compileOne x = do
mSolc <- do
stderr <- if solConf.quiet then UseHandle <$> openFile "/dev/null" WriteMode else pure Inherit
(ec, out, err) <- readCreateProcessWithExitCode (proc path $ (solConf.cryticArgs ++ solargs) |> x) {std_err = stderr} ""
stderr <- if solConf.quiet
then UseHandle <$> openFile "/dev/null" WriteMode
else pure Inherit
(ec, out, err) <- readCreateProcessWithExitCode
(proc path $ (solConf.cryticArgs ++ solargs) |> x) {std_err = stderr} ""
case ec of
ExitSuccess -> readSolcBatch "crytic-export"
ExitFailure _ -> throwM $ CompileFailure out err
@ -108,8 +112,8 @@ removeJsonFiles dir =
let path = dir </> file
whenM (doesFileExist path) $ removeFile path
addresses :: SolConf -> Set AbiValue
addresses SolConf{contractAddr, deployer, sender} = do
staticAddresses :: SolConf -> Set AbiValue
staticAddresses SolConf{contractAddr, deployer, sender} = do
Set.map AbiAddress $ Set.union sender (Set.fromList [contractAddr, deployer, 0x0])
populateAddresses :: Set Addr -> Integer -> VM -> VM
@ -158,7 +162,7 @@ abiOf pref solcContract =
-- filename their code is in, plus a colon.
loadSpecified
:: Env -> Maybe Text -> [SolcContract]
-> IO (VM, EventMap, [SolSignature], [Text], SignatureMap)
-> IO (VM, [SolSignature], [Text], SignatureMap)
loadSpecified env name cs = do
let solConf = env.cfg.solConf
@ -260,7 +264,7 @@ loadSpecified env name cs = do
case vm4._result of
Just (VMFailure _) -> throwM SetUpCallFailed
_ -> pure (vm4, unions $ map (.eventMap) cs, neFuns, fst <$> tests, abiMapping)
_ -> pure (vm4, neFuns, fst <$> tests, abiMapping)
where choose [] _ = throwM NoContracts
choose (c:_) Nothing = pure c
@ -269,32 +273,15 @@ loadSpecified env name cs = do
find (Data.Text.isSuffixOf (if T.any (== ':') n then n else ":" `append` n) . (.contractName)) cs
setUpFunction = ("setUp", [])
-- | Given a file and an optional contract name, compile the file as solidity, then, if a name is
-- given, try to fine the specified contract (assuming it is in the file provided), otherwise, find
-- the first contract in the file. Take said contract and return an initial VM state with it loaded,
-- its ABI (as 'SolSignature's), and the names of its Echidna tests. NOTE: unlike 'loadSpecified',
-- contract names passed here don't need the file they occur in specified.
loadWithCryticCompile :: Env -> NE.NonEmpty FilePath -> Maybe Text
-> IO (VM, EventMap, [SolSignature], [Text], SignatureMap)
loadWithCryticCompile env fp name =
contracts env.cfg.solConf fp >>= \(cs, _) -> loadSpecified env name cs
-- | Given the results of 'loadSolidity', assuming a single-contract test, get everything ready
-- for running a 'Campaign' against the tests found.
prepareForTest :: SolConf
-> (VM, EventMap, [SolSignature], [Text], SignatureMap)
-> Maybe ContractName
-> SlitherInfo
-> (VM, World, [EchidnaTest])
prepareForTest SolConf{sender, testMode, testDestruction} (vm, em, a, ts, m) c si = do
let r = vm._state._contract
ps = filterResults c si.payableFunctions
mkWorld :: SolConf -> EventMap -> SignatureMap -> Maybe ContractName -> SlitherInfo -> World
mkWorld SolConf{sender, testMode} em m c si =
let ps = filterResults c si.payableFunctions
as = if isAssertionMode testMode then filterResults c si.asserts else []
cs = if isDapptestMode testMode then [] else filterResults c si.constantFunctions \\ as
(hm, lm) = prepareHashMaps cs as $ filterFallbacks c si.fallbackDefined si.receiveDefined m
(vm, World sender hm lm ps em, createTests testMode testDestruction ts r a)
in World sender hm lm ps em
filterFallbacks :: Maybe ContractName -> [ContractName] -> [ContractName] -> SignatureMap -> SignatureMap
filterFallbacks _ [] [] sm = M.map f sm
@ -303,13 +290,6 @@ filterFallbacks _ [] [] sm = M.map f sm
ss' -> ss'
filterFallbacks _ _ _ sm = sm
-- this limited variant is used only in tests
prepareForTest' :: SolConf -> (VM, EventMap, [SolSignature], [Text], SignatureMap)
-> (VM, World, [EchidnaTest])
prepareForTest' SolConf{sender, testMode} (v, em, a, ts, _) = do
let r = v._state._contract
(v, World sender M.empty Nothing [] em, createTests testMode True ts r a)
prepareHashMaps :: [FunctionHash] -> [FunctionHash] -> SignatureMap -> (SignatureMap, Maybe SignatureMap)
prepareHashMaps [] _ m = (m, Nothing) -- No constant functions detected
prepareHashMaps cs as m =
@ -320,12 +300,20 @@ prepareHashMaps cs as m =
) (M.unionWith NEE.union (filterHashMap not cs m) (filterHashMap id as m), filterHashMap id cs m)
where filterHashMap f xs = M.mapMaybe (NE.nonEmpty . NE.filter (\s -> f $ (hashSig . encodeSig $ s) `elem` xs))
-- | Basically loadSolidity, but prepares the results to be passed directly into
-- a testing function.
-- | Given a file and an optional contract name, compile the file as solidity, then, if a name is
-- given, try to fine the specified contract (assuming it is in the file provided), otherwise, find
-- the first contract in the file. Take said contract and return an initial VM state with it loaded,
-- its ABI (as 'SolSignature's), and the names of its Echidna tests. NOTE: unlike 'loadSpecified',
-- contract names passed here don't need the file they occur in specified.
loadSolTests :: Env -> NE.NonEmpty FilePath -> Maybe Text -> IO (VM, World, [EchidnaTest])
loadSolTests env fp name = do
x <- loadWithCryticCompile env fp name
pure $ prepareForTest' env.cfg.solConf x
let solConf = env.cfg.solConf
(contracts, _) <- compileContracts solConf fp
(vm, funs, testNames, _signatureMap) <- loadSpecified env name contracts
let eventMap = Map.unions $ map (.eventMap) contracts
let world = World solConf.sender M.empty Nothing [] eventMap
let echidnaTests = createTests solConf.testMode True testNames vm._state._contract funs
pure (vm, world, echidnaTests)
mkLargeAbiInt :: Int -> AbiValue
mkLargeAbiInt i = AbiInt i $ 2 ^ (i - 1) - 1
@ -336,13 +324,15 @@ mkLargeAbiUInt i = AbiUInt i $ 2 ^ i - 1
mkSmallAbiInt :: Int -> AbiValue
mkSmallAbiInt i = AbiInt i $ -(2 ^ (i - 1))
timeConstants :: [AbiValue]
timeConstants = concatMap dec [initialTimestamp, initialBlockNumber]
timeConstants :: Set AbiValue
timeConstants = Set.fromList $ concatMap dec [initialTimestamp, initialBlockNumber]
where dec i = let l f = f <$> commonTypeSizes <*> fmap fromIntegral [i-1..i+1] in
catMaybes (l mkValidAbiInt ++ l mkValidAbiUInt)
extremeConstants :: [AbiValue]
extremeConstants = concatMap (\i -> [mkSmallAbiInt i, mkLargeAbiInt i, mkLargeAbiUInt i]) commonTypeSizes
extremeConstants :: Set AbiValue
extremeConstants =
Set.unions $
(\i -> Set.fromList [mkSmallAbiInt i, mkLargeAbiInt i, mkLargeAbiUInt i]) <$> commonTypeSizes
returnTypes :: [SolcContract] -> Text -> Maybe AbiType
returnTypes cs t = do

@ -44,7 +44,7 @@ import EVM.Types (Addr, keccak', W256)
import Echidna
import Echidna.Config
import Echidna.Types.Buffer (forceBuf)
import Echidna.Types.Campaign
import Echidna.Types.Campaign hiding (corpus)
import Echidna.Types.Config
import Echidna.Types.Solidity
import Echidna.Types.Test (TestMode, EchidnaTest(..))
@ -76,7 +76,7 @@ main = do
pure (Nothing, Nothing)
opts@Options{..} <- execParser optsParser
g <- getRandomR (0, maxBound)
seed <- getRandomR (0, maxBound)
EConfigWithUsage loadedCfg ks _ <-
maybe (pure (EConfigWithUsage defaultConfig mempty mempty)) parseConfig cliConfigFilepath
let cfg = overrideConfig loadedCfg opts
@ -91,13 +91,14 @@ main = do
, metadataCache = cacheMetaRef
, fetchContractCache = cacheContractsRef
, fetchSlotCache = cacheSlotsRef }
(vm, sourceCache, deployedContracts, world, ts, d, txs) <-
prepareContract env cliFilePath cliSelectedContract g
let solcByName = Map.fromList [(c.contractName, c) | c <- deployedContracts]
(vm, sourceCache, contracts, world, ts, dict) <-
prepareContract env cliFilePath cliSelectedContract seed
let solcByName = Map.fromList [(c.contractName, c) | c <- contracts]
-- TODO put in real path
let dappInfo' = dappInfo "/" solcByName sourceCache
corpus <- prepareCorpus env world
-- start ui and run tests
campaign <- runReaderT (ui vm world ts (Just d) txs) (env { dapp = dappInfo' })
campaign <- runReaderT (ui vm world ts (Just dict) corpus) (env { dapp = dappInfo' })
contractsCache <- readIORef cacheContractsRef
slotsCache <- readIORef cacheSlotsRef
@ -105,8 +106,10 @@ main = do
case maybeBlock of
Just block -> do
-- Save fetched data, it's okay to override as the cache only grows
JSON.encodeFile (".echidna" </> "block_" <> show block <> "_fetch_cache_contracts.json") (toFetchedContractData <$> Map.mapMaybe id contractsCache)
JSON.encodeFile (".echidna" </> "block_" <> show block <> "_fetch_cache_slots.json") slotsCache
JSON.encodeFile (".echidna" </> "block_" <> show block <> "_fetch_cache_contracts.json")
(toFetchedContractData <$> Map.mapMaybe id contractsCache)
JSON.encodeFile (".echidna" </> "block_" <> show block <> "_fetch_cache_slots.json")
slotsCache
Nothing ->
pure ()
@ -129,17 +132,16 @@ main = do
Just contract -> do
r <- externalSolcContract addr contract
case r of
Just (externalSourceCache, solcContract) ->
Just (externalSourceCache, solcContract) -> do
let dir' = dir </> show addr
in do
saveCoverage False runId dir' externalSourceCache [solcContract] campaign._coverage
saveCoverage True runId dir' externalSourceCache [solcContract] campaign._coverage
Nothing -> pure ()
Nothing -> pure ()) (Map.toList contractsCache)
-- save source coverage reports
saveCoverage False runId dir sourceCache deployedContracts campaign._coverage
saveCoverage True runId dir sourceCache deployedContracts campaign._coverage
saveCoverage False runId dir sourceCache contracts campaign._coverage
saveCoverage True runId dir sourceCache contracts campaign._coverage
if isSuccessful campaign then exitSuccess else exitWith (ExitFailure 1)
@ -151,7 +153,6 @@ main = do
externalSolcContract addr c = do
let runtimeCode = forceBuf $ view bytecode c
putStr $ "Fetching Solidity source for contract at address " <> show addr <> "... "
-- TODO: without ETHERSCAN_API_KEY there is 1req/5s limit
srcRet <- Etherscan.fetchContractSource addr
putStrLn $ if isJust srcRet then "Success!" else "Error!"
putStr $ "Fetching Solidity source map for contract at address " <> show addr <> "... "
@ -178,7 +179,7 @@ main = do
, eventMap = mempty -- error "TODO: mkEventMap abis"
, errorMap = mempty -- error "TODO: mkErrorMap abis"
, storageLayout = Nothing
, immutableReferences = mempty -- TODO: deprecate combined-json
, immutableReferences = mempty
}
pure (sourceCache, solcContract)

@ -102,11 +102,12 @@ runContract f mc cfg = do
, metadataCache = cacheMeta
, fetchContractCache = cacheContracts
, fetchSlotCache = cacheSlots }
(v, sc, cs, w, ts, d, txs) <- prepareContract env (f :| []) mc g
(vm, sc, cs, w, ts, d) <- prepareContract env (f :| []) mc g
let solcByName = fromList [(c.contractName, c) | c <- cs]
let dappInfo' = dappInfo "/" solcByName sc
let corpus = []
-- start ui and run tests
runReaderT (campaign (pure ()) v w ts (Just d) txs) (env { dapp = dappInfo' })
runReaderT (campaign (pure ()) vm w ts (Just d) corpus) (env { dapp = dappInfo' })
testContract :: FilePath -> Maybe FilePath -> [(String, Campaign -> Bool)] -> TestTree
testContract fp cfg = testContract' fp Nothing Nothing cfg True

@ -9,7 +9,7 @@ import Control.Monad.Catch (catch)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Echidna.Types.Solidity (SolException(..))
import Echidna.Solidity (loadWithCryticCompile)
import Echidna.Solidity (loadSolTests)
import Echidna.Types.Config (Env(..))
import EVM.Dapp (emptyDapp)
import Data.IORef (newIORef)
@ -47,4 +47,4 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where
, metadataCache = cacheMeta
, fetchContractCache = cacheContracts
, fetchSlotCache = cacheSlots }
void $ loadWithCryticCompile env (fp :| []) c
void $ loadSolTests env (fp :| []) c

Loading…
Cancel
Save