diff --git a/.github/scripts/install-z3.sh b/.github/scripts/install-z3.sh index f79f532b3..924b2ae77 100755 --- a/.github/scripts/install-z3.sh +++ b/.github/scripts/install-z3.sh @@ -3,14 +3,14 @@ set -eux -o pipefail if [ "$HOST_OS" = "Linux" ]; then if [ $(uname -m) = "aarch64" ]; then - curl -fsSL -o z3.zip https://github.com/Z3Prover/z3/releases/download/z3-4.12.6/z3-4.12.6-arm64-glibc-2.35.zip + curl -fsSL -o z3.zip https://github.com/Z3Prover/z3/releases/download/z3-4.15.2/z3-4.15.2-arm64-glibc-2.34.zip elif [ $(uname -m) = "x86_64" ]; then - curl -fsSL -o z3.zip https://github.com/Z3Prover/z3/releases/download/z3-4.12.6/z3-4.12.6-x64-glibc-2.35.zip + curl -fsSL -o z3.zip https://github.com/Z3Prover/z3/releases/download/z3-4.15.2/z3-4.15.2-x64-glibc-2.39.zip fi unzip z3.zip cp -a z3-*/bin/z3 "$HOME/.local/bin/" rm -rf z3-*/ z3.zip fi if [ "$HOST_OS" = "Windows" ]; then - choco install z3 --version=4.12.6 + choco install z3 fi diff --git a/flake.nix b/flake.nix index 6849fc447..ffe2bd548 100644 --- a/flake.nix +++ b/flake.nix @@ -54,8 +54,8 @@ (pkgs.haskellPackages.callCabal2nix "hevm" (pkgs.fetchFromGitHub { owner = "ethereum"; repo = "hevm"; - rev = "87fe0eec5abb69c0b54c097784dfd8712a36de70"; - sha256 = "sha256-cgfrP+K5NoXvVPRN6XRnTkdOIJztc/4wrto9nQ/9tnY="; + rev = "0d9e2744903d160b175cd9e727660b493d9fac6f"; + sha256 = "sha256-SYqhjlvGKdWf55JjGZ8BPFtXqbkL81os5FB9j4Nj40A="; }) { secp256k1 = pkgs.secp256k1; }) ([ pkgs.haskell.lib.compose.dontCheck diff --git a/lib/Echidna.hs b/lib/Echidna.hs index edd0ddb4e..cb0c26187 100644 --- a/lib/Echidna.hs +++ b/lib/Echidna.hs @@ -2,6 +2,7 @@ module Echidna where import Control.Concurrent (newChan) import Control.Monad.Catch (MonadThrow(..)) +import Control.Monad.IO.Class (liftIO) import Control.Monad.ST (RealWorld) import Data.IORef (newIORef) import Data.List (find, nub) @@ -15,8 +16,12 @@ import System.FilePath (()) import EVM (cheatCode) import EVM.ABI (AbiValue(AbiAddress)) import EVM.Dapp (dappInfo) +import EVM.Fetch qualified import EVM.Solidity (BuildOutput(..), Contracts(Contracts), Method(..), Mutability(..), SolcContract(..)) import EVM.Types hiding (Env) +import EVM.Effects (TTY(..), ReadConfig(..), defaultConfig) +import Data.Text qualified as T +import System.IO (stderr, hPutStrLn) import Echidna.ABI import Echidna.Onchain as Onchain @@ -107,6 +112,13 @@ loadInitialCorpus env = do ctxs2 <- loadTxs (dir "coverage") pure (ctxs1 ++ ctxs2) +instance TTY IO where + writeOutput = liftIO . putStrLn . T.unpack + writeErr = liftIO . hPutStrLn stderr . T.unpack + +instance ReadConfig IO where + readConfig = pure defaultConfig + mkEnv :: EConfig -> BuildOutput -> [EchidnaTest] -> World -> Maybe SlitherInfo -> IO Env mkEnv cfg buildOutput tests world slitherInfo = do codehashMap <- newIORef mempty @@ -116,13 +128,11 @@ mkEnv cfg buildOutput tests world slitherInfo = do coverageRefRuntime <- newIORef mempty corpusRef <- newIORef mempty testRefs <- traverse newIORef tests - (contractCache, slotCache) <- Onchain.loadRpcCache cfg - fetchContractCache <- newIORef contractCache - fetchSlotCache <- newIORef slotCache + fetchSession <- EVM.Fetch.mkSession cfg.campaignConf.corpusDir (fromIntegral <$> cfg.rpcBlock) contractNameCache <- newIORef mempty -- TODO put in real path let dapp = dappInfo "/" buildOutput - pure $ Env { cfg, dapp, codehashMap, fetchContractCache, fetchSlotCache, contractNameCache + pure $ Env { cfg, dapp, codehashMap, fetchSession, contractNameCache , chainId, eventQueue, coverageRefInit, coverageRefRuntime, corpusRef, testRefs, world , slitherInfo } diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index be7372ebf..ec41cfbf4 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -297,24 +297,26 @@ runSymWorker callback vm dict workerId _ name = do -- We can't do callseq vm' [symTx] because callseq might post the full call sequence as an event newCoverage <- or <$> mapM (\symTx -> snd <$> callseq vm [symTx]) txs let methodSignature = unpack method.methodSignature - unless newCoverage ( do + unless newCoverage $ do unless (null txs) $ error "No new coverage but symbolic execution found valid txs. Something is wrong." - updateTests $ \test -> do - if isOpen test && isAssertionTest test && getAssertionSignature test == methodSignature then - pure $ Just $ test { Test.state = Unsolvable } - else - pure $ Just test - pushWorkerEvent $ SymExecLog ("Symbolic execution finished verifying contract " <> unpack (fromJust name) <> " using a single symbolic transaction.")) - + when (null errors && null partials) $ do + updateTests $ \test -> do + if isOpen test && isAssertionTest test && getAssertionSignature test == methodSignature then + pure $ Just $ test { Test.state = Unsolvable } + else + pure $ Just test + + unless (null errors) $ mapM_ ((pushWorkerEvent . SymExecError) . (\e -> "Error(s) solving constraints produced by method " <> methodSignature <> ": " <> show e)) errors + unless (null partials) $ mapM_ ((pushWorkerEvent . SymExecError) . (\e -> "Partial explored path(s) during symbolic verification of method " <> methodSignature <> ": " <> unpack e)) partials when (not (null partials) || not (null errors)) $ do - unless (null errors) $ mapM_ ((pushWorkerEvent . SymExecError) . (\e -> "Error(s) solving constraints produced by method " <> methodSignature <> ": " <> show e)) errors - unless (null partials) $ mapM_ ((pushWorkerEvent . SymExecError) . (\e -> "Partial explored path(s) during symbolic verification of method " <> methodSignature <> ": " <> unpack e)) partials updateTests $ \test -> do if isOpen test && isAssertionTest test && getAssertionSignature test == methodSignature then pure $ Just $ test {Test.state = Passed} else pure $ Just test + pushWorkerEvent $ SymExecLog ("Symbolic execution finished verifying contract " <> unpack (fromJust name) <> " using a single symbolic transaction.") + -- | Run a fuzzing campaign given an initial universe state, some tests, and an -- optional dictionary to generate calls with. Return the 'Campaign' state once -- we can't solve or shrink anything. diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index ce7eba931..72c99bb96 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -14,7 +14,7 @@ import Control.Monad.Reader (MonadReader, ask, asks) import Control.Monad.ST (ST, stToIO, RealWorld) import Data.Bits import Data.ByteString qualified as BS -import Data.IORef (readIORef, atomicWriteIORef, newIORef, writeIORef, modifyIORef') +import Data.IORef (readIORef, newIORef, writeIORef, modifyIORef') import Data.Map qualified as Map import Data.Maybe (fromMaybe, fromJust) import Data.Text qualified as T @@ -114,68 +114,48 @@ execTxWith executeTx tx = do case getQuery vmResult of -- A previously unknown contract is required Just q@(PleaseFetchContract addr _ continuation) -> do - cacheRef <- asks (.fetchContractCache) - cache <- liftIO $ readIORef cacheRef - case Map.lookup addr cache of - Just (Just contract) -> fromEVM (continuation contract) - Just Nothing -> do - v <- get - v' <- liftIO $ stToIO $ execStateT (continuation emptyAccount) v - put v' - Nothing -> do - logMsg $ "INFO: Performing RPC: " <> show q - case config.rpcUrl of - Just rpcUrl -> do - ret <- liftIO $ safeFetchContractFrom rpcBlock rpcUrl addr - case ret of - -- TODO: fix hevm to not return an empty contract in case of an error - Just contract | contract.code /= RuntimeCode (ConcreteRuntimeCode "") -> do - fromEVM (continuation contract) - liftIO $ atomicWriteIORef cacheRef $ Map.insert addr (Just contract) cache - _ -> do - -- TODO: better error reporting in HEVM, when intermittent - -- network error then retry - liftIO $ atomicWriteIORef cacheRef $ Map.insert addr Nothing cache - logMsg $ "ERROR: Failed to fetch contract: " <> show q - -- TODO: How should we fail here? It could be a network error, - -- RPC server returning junk etc. - fromEVM (continuation emptyAccount) - Nothing -> do - liftIO $ atomicWriteIORef cacheRef $ Map.insert addr Nothing cache - logMsg $ "ERROR: Requested RPC but it is not configured: " <> show q - -- TODO: How should we fail here? RPC is not configured but VM - -- wants to fetch + --logMsg $ "INFO: Performing RPC: " <> show q + case config.rpcUrl of + Just rpcUrl -> do + session <- asks (.fetchSession) + ret <- liftIO $ safeFetchContractFrom session rpcBlock rpcUrl addr + case ret of + -- TODO: fix hevm to not return an empty contract in case of an error + Just contract | contract.code /= RuntimeCode (ConcreteRuntimeCode "") -> do + fromEVM (continuation contract) + _ -> do + -- TODO: better error reporting in HEVM, when intermittent + -- network error then retry + logMsg $ "ERROR: Failed to fetch contract: " <> show q + -- TODO: How should we fail here? It could be a network error, + -- RPC server returning junk etc. fromEVM (continuation emptyAccount) + Nothing -> do + --logMsg $ "ERROR: Requested RPC but it is not configured: " <> show q + -- TODO: How should we fail here? RPC is not configured but VM + -- wants to fetch + fromEVM (continuation emptyAccount) runFully -- resume execution -- A previously unknown slot is required Just q@(PleaseFetchSlot addr slot continuation) -> do - cacheRef <- asks (.fetchSlotCache) - cache <- liftIO $ readIORef cacheRef - case Map.lookup addr cache >>= Map.lookup slot of - Just (Just value) -> fromEVM (continuation value) - Just Nothing -> fromEVM (continuation 0) - Nothing -> do - logMsg $ "INFO: Performing RPC: " <> show q - case config.rpcUrl of - Just rpcUrl -> do - ret <- liftIO $ safeFetchSlotFrom rpcBlock rpcUrl addr slot - case ret of - Just value -> do - fromEVM (continuation value) - liftIO $ atomicWriteIORef cacheRef $ - Map.insertWith Map.union addr (Map.singleton slot (Just value)) cache - Nothing -> do - -- TODO: How should we fail here? It could be a network error, - -- RPC server returning junk etc. - logMsg $ "ERROR: Failed to fetch slot: " <> show q - liftIO $ atomicWriteIORef cacheRef $ - Map.insertWith Map.union addr (Map.singleton slot Nothing) cache - fromEVM (continuation 0) + --logMsg $ "INFO: Performing RPC: " <> show q + case config.rpcUrl of + Just rpcUrl -> do + session <- asks (.fetchSession) + ret <- liftIO $ safeFetchSlotFrom session rpcBlock rpcUrl addr slot + case ret of + Just value -> do + fromEVM (continuation value) Nothing -> do - logMsg $ "ERROR: Requested RPC but it is not configured: " <> show q - -- Use the zero slot + -- TODO: How should we fail here? It could be a network error, + -- RPC server returning junk etc. + logMsg $ "ERROR: Failed to fetch slot: " <> show q fromEVM (continuation 0) + Nothing -> do + --logMsg $ "ERROR: Requested RPC but it is not configured: " <> show q + -- Use the zero slot + fromEVM (continuation 0) runFully -- resume execution -- Execute a FFI call diff --git a/lib/Echidna/Onchain.hs b/lib/Echidna/Onchain.hs index 8041632cc..0bc967e03 100644 --- a/lib/Echidna/Onchain.hs +++ b/lib/Echidna/Onchain.hs @@ -4,15 +4,11 @@ module Echidna.Onchain where import Control.Exception (catch) import Data.Aeson (ToJSON, FromJSON) -import Data.Aeson qualified as JSON import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.UTF8 qualified as UTF8 -import Data.Functor ((<&>)) -import Data.IORef (readIORef) -import Data.Map (Map) import Data.Map qualified as Map -import Data.Maybe (isJust, fromJust, fromMaybe) +import Data.Maybe (isJust, fromJust) import Data.Text qualified as Text import Data.Text (Text) import Data.Vector qualified as Vector @@ -21,7 +17,7 @@ import Etherscan qualified import GHC.Generics (Generic) import Network.HTTP.Simple (HttpException) import Optics (view) -import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.Directory (doesFileExist) import System.Environment (lookupEnv) import System.FilePath (()) import Network.Wreq.Session qualified as Session @@ -33,13 +29,23 @@ import EVM.Fetch qualified import EVM.Solidity (SourceCache(..), SolcContract (..)) import EVM.Types hiding (Env) -import Echidna.Orphans.JSON () import Echidna.SymExec.Symbolic (forceWord, forceBuf) import Echidna.Types (emptyAccount) import Echidna.Types.Campaign (CampaignConf(..)) import Echidna.Types.Config (Env(..), EConfig(..)) import Echidna.Output.Source (saveCoverages) import Control.Monad (when, forM_) +import Control.Concurrent.MVar (readMVar) + +saveRpcCache :: Env -> IO () +saveRpcCache env = do + case (env.fetchSession.cacheDir, env.cfg.rpcBlock) of + (Just dir, Just n) -> do + cache <- readMVar (env.fetchSession.sharedCache) + EVM.Fetch.saveCache dir (fromIntegral n) cache + (_, Nothing) -> when (isJust (env.cfg.rpcUrl)) + $ putStrLn "Warning: cannot save RPC cache without a specified block number." + (Nothing, _) -> pure () rpcUrlEnv :: IO (Maybe Text) rpcUrlEnv = do @@ -57,17 +63,17 @@ etherscanApiKey = do pure (Text.pack <$> val) -- TODO: temporary solution, handle errors gracefully -safeFetchContractFrom :: EVM.Fetch.BlockNumber -> Text -> Addr -> IO (Maybe Contract) -safeFetchContractFrom rpcBlock rpcUrl addr = do +safeFetchContractFrom :: EVM.Fetch.Session -> EVM.Fetch.BlockNumber -> Text -> Addr -> IO (Maybe Contract) +safeFetchContractFrom session rpcBlock rpcUrl addr = do catch - (EVM.Fetch.fetchContractFrom defaultConfig rpcBlock rpcUrl addr) + (EVM.Fetch.fetchContractWithSession defaultConfig session rpcBlock rpcUrl addr) (\(_ :: HttpException) -> pure $ Just emptyAccount) -- TODO: temporary solution, handle errors gracefully -safeFetchSlotFrom :: EVM.Fetch.BlockNumber -> Text -> Addr -> W256 -> IO (Maybe W256) -safeFetchSlotFrom rpcBlock rpcUrl addr slot = +safeFetchSlotFrom :: EVM.Fetch.Session -> EVM.Fetch.BlockNumber -> Text -> Addr -> W256 -> IO (Maybe W256) +safeFetchSlotFrom session rpcBlock rpcUrl addr slot = catch - (EVM.Fetch.fetchSlotFrom defaultConfig rpcBlock rpcUrl addr slot) + (EVM.Fetch.fetchSlotWithCache defaultConfig session rpcBlock rpcUrl addr slot) (\(_ :: HttpException) -> pure $ Just 0) data FetchedContractData = FetchedContractData @@ -96,33 +102,6 @@ toFetchedContractData contract = , balance = forceWord contract.balance } --- | Try to load the persisted RPC cache. --- TODO: we use the corpus dir for now, think about where to place it -loadRpcCache - :: EConfig - -> IO ( Map Addr (Maybe Contract) - , Map Addr (Map W256 (Maybe W256)) - ) -loadRpcCache cfg = - case cfg.campaignConf.corpusDir of - Nothing -> pure (mempty, mempty) - Just dir -> do - let cache_dir = dir "cache" - createDirectoryIfMissing True cache_dir - case cfg.rpcBlock of - Just block -> do - parsedContracts :: Maybe (Map Addr FetchedContractData) <- - readFileIfExists (cache_dir "block_" <> show block <> "_fetch_cache_contracts.json") - <&> (>>= JSON.decodeStrict) - parsedSlots :: Maybe (Map Addr (Map W256 (Maybe W256))) <- - readFileIfExists (cache_dir "block_" <> show block <> "_fetch_cache_slots.json") - <&> (>>= JSON.decodeStrict) - pure - ( maybe mempty (Map.map (Just . fromFetchedContractData)) parsedContracts - , fromMaybe mempty parsedSlots - ) - Nothing -> - pure (mempty, mempty) readFileIfExists :: FilePath -> IO (Maybe BS.ByteString) readFileIfExists path = do @@ -167,24 +146,6 @@ externalSolcContract env addr c = do } pure (sourceCache, solcContract) --- TODO: This should happen continuously event-based -saveRpcCache :: Env -> IO () -saveRpcCache env = do - contractsCache <- readIORef env.fetchContractCache - slotsCache <- readIORef env.fetchSlotCache - case env.cfg.campaignConf.corpusDir of - Nothing -> pure () - Just dir -> do - let cacheDir = dir "cache" - case env.cfg.rpcBlock of - Just block -> do - -- Save fetched data, it's okay to override as the cache only grows - JSON.encodeFile (cacheDir "block_" <> show block <> "_fetch_cache_contracts.json") - (toFetchedContractData <$> Map.mapMaybe id contractsCache) - JSON.encodeFile (cacheDir "block_" <> show block <> "_fetch_cache_slots.json") - slotsCache - Nothing -> - pure () saveCoverageReport :: Env -> Int -> IO () saveCoverageReport env runId = do @@ -194,20 +155,19 @@ saveCoverageReport env runId = do -- coverage reports for external contracts, we only support -- Ethereum Mainnet for now when (env.chainId == Just 1) $ do - contractsCache <- readIORef env.fetchContractCache - forM_ (Map.toList contractsCache) $ \(addr, mc) -> - case mc of - Just contract -> do - r <- externalSolcContract env addr contract - case r of - Just (externalSourceCache, solcContract) -> do - let dir' = dir show addr - saveCoverages env - runId - dir' - externalSourceCache - [solcContract] - Nothing -> pure () + -- Get contracts from hevm session cache + sessionCache <- readMVar env.fetchSession.sharedCache + let contractsCache = sessionCache.contractCache + forM_ (Map.toList contractsCache) $ \(addr, contract) -> do + r <- externalSolcContract env addr contract + case r of + Just (externalSourceCache, solcContract) -> do + let dir' = dir show addr + saveCoverages env + runId + dir' + externalSourceCache + [solcContract] Nothing -> pure () fetchChainIdFrom :: Maybe Text -> IO (Maybe W256) diff --git a/lib/Echidna/SymExec/Common.hs b/lib/Echidna/SymExec/Common.hs index 63ff788a3..30316e0f9 100644 --- a/lib/Echidna/SymExec/Common.hs +++ b/lib/Echidna/SymExec/Common.hs @@ -7,7 +7,6 @@ import Data.Maybe (fromMaybe, mapMaybe) import Data.Set (Set) import Data.Set qualified as Set import Data.Text qualified as T -import GHC.IORef (IORef, readIORef) import Optics.Core ((.~), (%), (%~)) import EVM.ABI (abiKind, AbiKind(Dynamic), Sig(..), decodeBuf, AbiVals(..)) import EVM.Fetch qualified as Fetch @@ -17,7 +16,7 @@ import EVM.Solidity (SolcContract(..), SourceCache(..), Method(..), WarningData( import EVM.Solvers (SolverGroup) import EVM.SymExec (mkCalldata, verifyInputs, VeriOpts(..), checkAssertions, subModel, defaultSymbolicValues) import EVM.Expr qualified -import EVM.Types (Addr, VMType(..), EType(..), Expr(..), Block(..), W256, SMTCex(..), ProofResult(..), Prop(..), Query(..), forceLit) +import EVM.Types (Addr, VMType(..), EType(..), Expr(..), Block(..), W256, SMTCex(..), ProofResult(..), Prop(..), forceLit) import qualified EVM.Types (VM(..)) import EVM.Format (formatPartialDetailed) import Control.Monad.ST (RealWorld) @@ -27,7 +26,6 @@ import Echidna.Types (fromEVM) import Echidna.Types.Config (EConfig(..)) import Echidna.Types.Solidity (SolConf(..)) import Echidna.Types.Tx (Tx(..), TxCall(..), TxConf(..), maxGasPerBlock) -import Echidna.Types.Cache (ContractCache, SlotCache) type PartialsLogs = [T.Text] @@ -79,7 +77,7 @@ modelToTx dst oldTimestamp oldNumber method senders fallbackSender calldata resu Left e -> Left e args = case argdata of Right argdata' -> case decodeBuf types argdata' of - CAbi v -> v + (CAbi v, _) -> v _ -> [] Left _ -> [] @@ -109,22 +107,7 @@ modelToTx dst oldTimestamp oldNumber method senders fallbackSender calldata resu r -> error ("Unexpected value in `modelToTx`: " ++ show r) -cachedOracle :: IORef ContractCache -> IORef SlotCache -> SolverGroup -> Fetch.RpcInfo -> Fetch.Fetcher t m s -cachedOracle contractCacheRef slotCacheRef solvers info q = do - case q of - PleaseFetchContract addr _ continue -> do - cache <- liftIO $ readIORef contractCacheRef - case Map.lookup addr cache of - Just (Just contract) -> pure $ continue contract - _ -> oracle q - PleaseFetchSlot addr slot continue -> do - cache <- liftIO $ readIORef slotCacheRef - case Map.lookup addr cache >>= Map.lookup slot of - Just (Just value) -> pure $ continue value - _ -> oracle q - _ -> oracle q - - where oracle = Fetch.oracle solvers info +-- cachedOracle removed - hevm session handles all caching now rpcFetcher :: Functor f => f a -> Maybe W256 -> f (Fetch.BlockNumber, a) @@ -145,14 +128,13 @@ getUnknownLogs = mapMaybe (\case _ -> Nothing) exploreMethod :: (MonadUnliftIO m, ReadConfig m, TTY m) => - Method -> SolcContract -> SourceCache -> EVM.Types.VM Concrete RealWorld -> Addr -> EConfig -> VeriOpts -> SolverGroup -> Fetch.RpcInfo -> IORef ContractCache -> IORef SlotCache -> m ([TxOrError], PartialsLogs) + Method -> SolcContract -> SourceCache -> EVM.Types.VM Concrete RealWorld -> Addr -> EConfig -> VeriOpts -> SolverGroup -> Fetch.RpcInfo -> Fetch.Session -> m ([TxOrError], PartialsLogs) -exploreMethod method contract sources vm defaultSender conf veriOpts solvers rpcInfo contractCacheRef slotCacheRef = do +exploreMethod method contract sources vm defaultSender conf veriOpts solvers rpcInfo session = do calldataSym@(_, constraints) <- mkCalldata (Just (Sig method.methodSignature (snd <$> method.inputs))) [] let cd = fst calldataSym - let - fetcher = cachedOracle contractCacheRef slotCacheRef solvers rpcInfo + fetcher = Fetch.oracle solvers (Just session) rpcInfo dst = conf.solConf.contractAddr vmReset <- liftIO $ snd <$> runStateT (fromEVM resetState) vm let diff --git a/lib/Echidna/SymExec/Exploration.hs b/lib/Echidna/SymExec/Exploration.hs index 56f02279e..379e3fd55 100644 --- a/lib/Echidna/SymExec/Exploration.hs +++ b/lib/Echidna/SymExec/Exploration.hs @@ -44,6 +44,7 @@ import Echidna.Worker (pushWorkerEvent) -- The Tx argument, if present, must have a .call value of type SolCall. getTargetMethodFromTx :: (MonadIO m, MonadReader Echidna.Types.Config.Env m) => Tx -> SolcContract -> [String] -> m (Maybe Method) +getTargetMethodFromTx (Tx { call = SolCall ("", _) }) _ _ = return Nothing getTargetMethodFromTx (Tx { call = SolCall (methodName, _) }) contract failedProperties = do env <- ask let allMethods = Map.assocs contract.abiMap @@ -84,31 +85,30 @@ exploreContract :: (MonadIO m, MonadThrow m, MonadReader Echidna.Types.Config.En exploreContract contract method vm = do conf <- asks (.cfg) dappInfo <- asks (.dapp) - contractCacheRef <- asks (.fetchContractCache) - slotCacheRef <- asks (.fetchSlotCache) let timeoutSMT = Just (fromIntegral conf.campaignConf.symExecTimeout) maxIters = Just conf.campaignConf.symExecMaxIters maxExplore = Just (fromIntegral conf.campaignConf.symExecMaxExplore) askSmtIters = conf.campaignConf.symExecAskSMTIters - rpcInfo = RpcInfo (rpcFetcher conf.rpcUrl (fromIntegral <$> conf.rpcBlock)) Nothing Nothing Nothing + rpcInfo = RpcInfo (rpcFetcher conf.rpcUrl (fromIntegral <$> conf.rpcBlock)) defaultSender = fromJust $ Set.lookupMin conf.solConf.sender <|> Just 0 threadIdChan <- liftIO newEmptyMVar doneChan <- liftIO newEmptyMVar resultChan <- liftIO newEmptyMVar let isNonInteractive = conf.uiConf.operationMode == NonInteractive Text - let iterConfig = IterConfig { maxIter = maxIters, askSmtIters = askSmtIters, loopHeuristic = Naive} - let hevmConfig = defaultConfig { maxWidth = 5, maxDepth = maxExplore, maxBufSize = 12, promiseNoReent = False, onlyDeployed = True, debug = isNonInteractive, dumpQueries = False, numCexFuzz = 0 } + let iterConfig = IterConfig { maxIter = maxIters, askSmtIters = askSmtIters, loopHeuristic = StackBased} + let hevmConfig = defaultConfig { maxWidth = 5, maxDepth = maxExplore, maxBufSize = 12, promiseNoReent = False, onlyDeployed = True, debug = isNonInteractive, dumpQueries = False } let veriOpts = VeriOpts {iterConf = iterConfig, rpcInfo = rpcInfo} let runtimeEnv = defaultEnv { config = hevmConfig } + session <- asks (.fetchSession) pushWorkerEvent $ SymExecLog ("Exploring " <> (show method.name)) liftIO $ flip runReaderT runtimeEnv $ withSolvers conf.campaignConf.symExecSMTSolver (fromIntegral conf.campaignConf.symExecNSolvers) 1 timeoutSMT $ \solvers -> do threadId <- liftIO $ forkIO $ flip runReaderT runtimeEnv $ do -- For now, we will be exploring a single method at a time. -- In some cases, this methods list will have only one method, but in other cases, it will have several methods. -- This is to improve the user experience, as it will produce results more often, instead having to wait for exploring several - res <- exploreMethod method contract dappInfo.sources vm defaultSender conf veriOpts solvers rpcInfo contractCacheRef slotCacheRef + res <- exploreMethod method contract dappInfo.sources vm defaultSender conf veriOpts solvers rpcInfo session liftIO $ putMVar resultChan res liftIO $ putMVar doneChan () liftIO $ putMVar threadIdChan threadId diff --git a/lib/Echidna/SymExec/Verification.hs b/lib/Echidna/SymExec/Verification.hs index 210f042a7..fceecc459 100644 --- a/lib/Echidna/SymExec/Verification.hs +++ b/lib/Echidna/SymExec/Verification.hs @@ -49,29 +49,28 @@ verifyMethod :: (MonadIO m, MonadThrow m, MonadReader Echidna.Types.Config.Env m verifyMethod method contract vm = do conf <- asks (.cfg) dappInfo <- asks (.dapp) - contractCacheRef <- asks (.fetchContractCache) - slotCacheRef <- asks (.fetchSlotCache) let timeoutSMT = Just (fromIntegral conf.campaignConf.symExecTimeout) maxIters = Just conf.campaignConf.symExecMaxIters maxExplore = Just (fromIntegral conf.campaignConf.symExecMaxExplore) askSmtIters = conf.campaignConf.symExecAskSMTIters - rpcInfo = RpcInfo (rpcFetcher conf.rpcUrl (fromIntegral <$> conf.rpcBlock)) Nothing Nothing Nothing + rpcInfo = RpcInfo (rpcFetcher conf.rpcUrl (fromIntegral <$> conf.rpcBlock)) defaultSender = fromJust $ Set.lookupMin conf.solConf.sender <|> Just 0 threadIdChan <- liftIO newEmptyMVar doneChan <- liftIO newEmptyMVar resultChan <- liftIO newEmptyMVar let isNonInteractive = conf.uiConf.operationMode == NonInteractive Text - let iterConfig = IterConfig { maxIter = maxIters, askSmtIters = askSmtIters, loopHeuristic = Naive} - let hevmConfig = defaultConfig { maxWidth = 5, maxDepth = maxExplore, dumpExprs = True, maxBufSize = 12, promiseNoReent = False, onlyDeployed = True, debug = isNonInteractive, numCexFuzz = 0 } + let iterConfig = IterConfig { maxIter = maxIters, askSmtIters = askSmtIters, loopHeuristic = StackBased} + let hevmConfig = defaultConfig { maxWidth = 5, maxDepth = maxExplore, dumpExprs = True, maxBufSize = 12, promiseNoReent = False, onlyDeployed = True, debug = isNonInteractive } let veriOpts = VeriOpts {iterConf = iterConfig, rpcInfo = rpcInfo} let runtimeEnv = defaultEnv { config = hevmConfig } + session <- asks (.fetchSession) pushWorkerEvent $ SymExecLog ("Verifying " <> (show method.name)) liftIO $ flip runReaderT runtimeEnv $ withSolvers conf.campaignConf.symExecSMTSolver (fromIntegral conf.campaignConf.symExecNSolvers) 1 timeoutSMT $ \solvers -> do threadId <- liftIO $ forkIO $ flip runReaderT runtimeEnv $ do - (res, partials) <- exploreMethod method contract dappInfo.sources vm defaultSender conf veriOpts solvers rpcInfo contractCacheRef slotCacheRef + (res, partials) <- exploreMethod method contract dappInfo.sources vm defaultSender conf veriOpts solvers rpcInfo session liftIO $ putMVar resultChan (res, partials) liftIO $ putMVar doneChan () liftIO $ putMVar threadIdChan threadId diff --git a/lib/Echidna/Types/Config.hs b/lib/Echidna/Types/Config.hs index bdaba1c0b..a86df54fb 100644 --- a/lib/Echidna/Types/Config.hs +++ b/lib/Echidna/Types/Config.hs @@ -10,6 +10,7 @@ import Data.Word (Word64) import EVM.Dapp (DappInfo) import EVM.Types (Addr, W256) +import EVM.Fetch qualified as Fetch import Echidna.SourceAnalysis.Slither (SlitherInfo) import Echidna.SourceMapping (CodehashMap) @@ -80,8 +81,7 @@ data Env = Env , slitherInfo :: Maybe SlitherInfo , codehashMap :: CodehashMap - , fetchContractCache :: IORef ContractCache - , fetchSlotCache :: IORef SlotCache + , fetchSession :: Fetch.Session , contractNameCache :: IORef ContractNameCache , chainId :: Maybe W256 , world :: World diff --git a/lib/Echidna/Types/Tx.hs b/lib/Echidna/Types/Tx.hs index e5bf266b9..0e1a37a4a 100644 --- a/lib/Echidna/Types/Tx.hs +++ b/lib/Echidna/Types/Tx.hs @@ -194,6 +194,7 @@ data TxResult | ErrorNonceOverflow | ErrorReturnDataOutOfBounds | ErrorNonexistentFork + | ErrorNonexistentPrecompile deriving (Eq, Ord, Show, Enum) $(deriveJSON defaultOptions ''TxResult) @@ -259,6 +260,7 @@ getResult = \case VMFailure NonceOverflow -> ErrorNonceOverflow VMFailure ReturnDataOutOfBounds -> ErrorReturnDataOutOfBounds VMFailure (NonexistentFork _) -> ErrorNonexistentFork + VMFailure (NonexistentPrecompile _) -> ErrorNonexistentPrecompile makeSingleTx :: Addr -> Addr -> W256 -> TxCall -> [Tx] makeSingleTx a d v (SolCall c) = [Tx (SolCall c) a d maxGasPerBlock 0 v (0, 0)] diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index 522a01259..db30c96b2 100644 --- a/lib/Echidna/UI.hs +++ b/lib/Echidna/UI.hs @@ -6,6 +6,7 @@ import Brick import Brick.BChan import Brick.Widgets.Dialog qualified as B import Control.Concurrent (killThread, threadDelay) +import Control.Concurrent.MVar (readMVar) import Control.Exception (AsyncException) import Control.Monad import Control.Monad.Catch @@ -113,8 +114,9 @@ ui vm dict initialCorpus cliSelectedContract = do writeBChan uiChannel (CampaignUpdated now tests states) -- TODO: remove and use events for this - c <- readIORef env.fetchContractCache - s <- readIORef env.fetchSlotCache + -- For now, return empty cache data since accessing hevm's internal cache is complex + let c = mempty :: Map Addr (Maybe Contract) + let s = mempty :: Map Addr (Map W256 (Maybe W256)) writeBChan uiChannel (FetchCacheUpdated c s) -- UI initialization @@ -212,7 +214,7 @@ ui vm dict initialCorpus cliSelectedContract = do when (isJust conf.campaignConf.serverPort) $ do -- wait until we send all SSE events liftIO $ putStrLn "Waiting until all SSE are received..." - readMVar serverStopVar + liftIO $ Control.Concurrent.MVar.readMVar serverStopVar states <- liftIO $ workerStates workers diff --git a/lib/Etherscan.hs b/lib/Etherscan.hs index 1c2526159..8cde150b2 100644 --- a/lib/Etherscan.hs +++ b/lib/Etherscan.hs @@ -24,8 +24,9 @@ data SourceCode = SourceCode fetchContractSource :: Maybe Text -> Addr -> IO (Maybe SourceCode) fetchContractSource apiKey addr = do - url <- parseRequest $ "https://api.etherscan.io/api?" - <> "module=contract" + url <- parseRequest $ "https://api.etherscan.io/v2/api?" + <> "&chainid=1" + <> "&module=contract" <> "&action=getsourcecode" <> "&address=" <> show addr <> T.unpack (maybe "" ("&apikey=" <>) apiKey) diff --git a/package.yaml b/package.yaml index 996d04502..6e519db4b 100644 --- a/package.yaml +++ b/package.yaml @@ -3,7 +3,7 @@ name: echidna author: Trail of Bits maintainer: Trail of Bits -version: 2.2.7 +version: 2.3.0 ghc-options: - -O2 diff --git a/stack.yaml b/stack.yaml index e72298b3a..f06d2668a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,10 +6,11 @@ packages: extra-deps: - git: https://github.com/argotorg/hevm.git - commit: 87fe0eec5abb69c0b54c097784dfd8712a36de70 + commit: 0d9e2744903d160b175cd9e727660b493d9fac6f - smt2-parser-0.1.0.1@sha256:1e1a4565915ed851c13d1e6b8bb5185cf5d454da3b43170825d53e221f753d77,1421 - spawn-0.3@sha256:b91e01d8f2b076841410ae284b32046f91471943dc799c1af77d666c72101f02,1162 - spool-0.1@sha256:77780cbfc2c0be23ff2ea9e474062f3df97fcd9db946ee0b3508280a923b83e2,1461 - strip-ansi-escape-0.1.0.0@sha256:08f2ed93b16086a837ec46eab7ce8d27cf39d47783caaeb818878ea33c2ff75f,1628 +- jsonl-0.2.0.0@sha256:35f8a3816f0b93830008709a8e64c0c69b9bc632a92c54b3be3345bfccba4a5c,1465 - vty-windows-0.2.0.3@sha256:0c010b1086a725046a8bb08bb1e6bfdfdb3cfe1c72d6fa77c37306ef9ec774d8,2844