Skip to content

Commit e4be047

Browse files
gustavo-griecoelopez
gustavo-grieco
and
elopez
authored
Do not fetch if etherscan key is not available and support different chain ids (#1492)
* do not fetch if etherscan key is not available and support different chain ids * etherscan: add support for source maps on other chains * etherscan: move cache away from Env * etherscan: remove extra & on URLs * onchain: remove dead code --------- Co-authored-by: Emilio López <[email protected]>
1 parent cf9bfb1 commit e4be047

File tree

3 files changed

+150
-106
lines changed

3 files changed

+150
-106
lines changed

‎lib/Echidna/Onchain.hs‎

Lines changed: 67 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,18 @@
1-
{-# LANGUAGE DeriveAnyClass #-}
2-
3-
module Echidna.Onchain where
1+
module Echidna.Onchain
2+
( etherscanApiKey
3+
, fetchChainIdFrom
4+
, rpcBlockEnv
5+
, rpcUrlEnv
6+
, safeFetchContractFrom
7+
, safeFetchSlotFrom
8+
, saveCoverageReport
9+
, saveRpcCache
10+
)
11+
where
412

513
import Control.Concurrent.MVar (readMVar)
614
import Control.Exception (catch)
715
import Control.Monad (when, forM_)
8-
import Data.Aeson (ToJSON, FromJSON)
9-
import Data.ByteString (ByteString)
1016
import Data.ByteString qualified as BS
1117
import Data.ByteString.UTF8 qualified as UTF8
1218
import Data.Map qualified as Map
@@ -16,23 +22,21 @@ import Data.Text qualified as Text
1622
import Data.Vector qualified as Vector
1723
import Data.Word (Word64)
1824
import Etherscan qualified
19-
import GHC.Generics (Generic)
2025
import Network.HTTP.Simple (HttpException)
2126
import Network.Wreq.Session qualified as Session
2227
import Optics (view)
23-
import System.Directory (doesFileExist)
2428
import System.Environment (lookupEnv)
2529
import System.FilePath ((</>))
2630
import Text.Read (readMaybe)
2731

28-
import EVM (initialContract, bytecode)
32+
import EVM (bytecode)
2933
import EVM.Effects (defaultConfig)
3034
import EVM.Fetch qualified
3135
import EVM.Solidity (SourceCache(..), SolcContract (..))
3236
import EVM.Types hiding (Env)
3337

3438
import Echidna.Output.Source (saveCoverages)
35-
import Echidna.SymExec.Symbolic (forceWord, forceBuf)
39+
import Echidna.SymExec.Symbolic (forceBuf)
3640
import Echidna.Types.Campaign (CampaignConf(..))
3741
import Echidna.Types.Config (Env(..), EConfig(..))
3842

@@ -79,99 +83,69 @@ safeFetchSlotFrom session rpcBlock rpcUrl addr slot =
7983
(EVM.Fetch.fetchSlotWithCache defaultConfig session rpcBlock rpcUrl addr slot)
8084
(\(e :: HttpException) -> pure $ EVM.Fetch.FetchError (Text.pack $ show e))
8185

82-
data FetchedContractData = FetchedContractData
83-
{ runtimeCode :: ByteString
84-
, nonce :: Maybe W64
85-
, balance :: W256
86-
}
87-
deriving (Generic, ToJSON, FromJSON, Show)
88-
89-
fromFetchedContractData :: FetchedContractData -> Contract
90-
fromFetchedContractData contractData =
91-
(initialContract (RuntimeCode (ConcreteRuntimeCode contractData.runtimeCode)))
92-
{ nonce = contractData.nonce
93-
, balance = Lit contractData.balance
94-
, external = True
95-
}
96-
97-
toFetchedContractData :: Contract -> FetchedContractData
98-
toFetchedContractData contract =
99-
let code = case contract.code of
100-
RuntimeCode (ConcreteRuntimeCode c) -> c
101-
_ -> error "unexpected code"
102-
in FetchedContractData
103-
{ runtimeCode = code
104-
, nonce = contract.nonce
105-
, balance = forceWord contract.balance
106-
}
107-
108-
109-
readFileIfExists :: FilePath -> IO (Maybe BS.ByteString)
110-
readFileIfExists path = do
111-
exists <- doesFileExist path
112-
if exists then Just <$> BS.readFile path else pure Nothing
113-
11486
-- | "Reverse engineer" the SolcContract and SourceCache structures for the
11587
-- code fetched from the outside
116-
externalSolcContract :: Env -> Addr -> Contract -> IO (Maybe (SourceCache, SolcContract))
117-
externalSolcContract env addr c = do
118-
let runtimeCode = forceBuf $ fromJust $ view bytecode c
119-
putStr $ "Fetching Solidity source for contract at address " <> show addr <> "... "
120-
srcRet <- Etherscan.fetchContractSource env.cfg.etherscanApiKey addr
121-
putStrLn $ if isJust srcRet then "Success!" else "Error!"
122-
putStr $ "Fetching Solidity source map for contract at address " <> show addr <> "... "
123-
srcmapRet <- Etherscan.fetchContractSourceMap addr
124-
putStrLn $ if isJust srcmapRet then "Success!" else "Error!"
125-
pure $ do
126-
src <- srcRet
127-
(_, srcmap) <- srcmapRet
128-
let
129-
files = Map.singleton 0 (show addr, UTF8.fromString src.code)
130-
sourceCache = SourceCache
131-
{ files
132-
, lines = Vector.fromList . BS.split 0xa . snd <$> files
133-
, asts = mempty
134-
}
135-
solcContract = SolcContract
136-
{ runtimeCode = runtimeCode
137-
, creationCode = mempty
138-
, runtimeCodehash = keccak' runtimeCode
139-
, creationCodehash = keccak' mempty
140-
, runtimeSrcmap = mempty
141-
, creationSrcmap = srcmap
142-
, contractName = src.name
143-
, constructorInputs = [] -- error "TODO: mkConstructor abis TODO"
144-
, abiMap = mempty -- error "TODO: mkAbiMap abis"
145-
, eventMap = mempty -- error "TODO: mkEventMap abis"
146-
, errorMap = mempty -- error "TODO: mkErrorMap abis"
147-
, storageLayout = Nothing
148-
, immutableReferences = mempty
149-
}
150-
pure (sourceCache, solcContract)
88+
externalSolcContract :: Env -> String -> Addr -> Contract -> IO (Maybe (SourceCache, SolcContract))
89+
externalSolcContract env explorerUrl addr c = do
90+
case env.cfg.etherscanApiKey of
91+
Nothing -> pure Nothing
92+
Just _ -> do
93+
let runtimeCode = forceBuf $ fromJust $ view bytecode c
94+
putStr $ "Fetching Solidity source for contract at address " <> show addr <> "... "
95+
srcRet <- Etherscan.fetchContractSource env.chainId env.cfg.etherscanApiKey addr
96+
putStrLn $ if isJust srcRet then "Success!" else "Error!"
97+
putStr $ "Fetching Solidity source map for contract at address " <> show addr <> "... "
98+
srcmapRet <- Etherscan.fetchContractSourceMap explorerUrl addr
99+
putStrLn $ if isJust srcmapRet then "Success!" else "Error!"
100+
pure $ do
101+
src <- srcRet
102+
(_, srcmap) <- srcmapRet
103+
let
104+
files = Map.singleton 0 (show addr, UTF8.fromString src.code)
105+
sourceCache = SourceCache
106+
{ files
107+
, lines = Vector.fromList . BS.split 0xa . snd <$> files
108+
, asts = mempty
109+
}
110+
solcContract = SolcContract
111+
{ runtimeCode = runtimeCode
112+
, creationCode = mempty
113+
, runtimeCodehash = keccak' runtimeCode
114+
, creationCodehash = keccak' mempty
115+
, runtimeSrcmap = mempty
116+
, creationSrcmap = srcmap
117+
, contractName = src.name
118+
, constructorInputs = [] -- error "TODO: mkConstructor abis TODO"
119+
, abiMap = mempty -- error "TODO: mkAbiMap abis"
120+
, eventMap = mempty -- error "TODO: mkEventMap abis"
121+
, errorMap = mempty -- error "TODO: mkErrorMap abis"
122+
, storageLayout = Nothing
123+
, immutableReferences = mempty
124+
}
125+
pure (sourceCache, solcContract)
151126

152127

153128
saveCoverageReport :: Env -> Int -> IO ()
154129
saveCoverageReport env runId = do
155130
case env.cfg.campaignConf.corpusDir of
156131
Nothing -> pure ()
157132
Just dir -> do
158-
-- coverage reports for external contracts, we only support
159-
-- Ethereum Mainnet for now
160-
when (env.chainId == Just 1) $ do
161-
-- Get contracts from hevm session cache
162-
sessionCache <- readMVar env.fetchSession.sharedCache
163-
let contractsCache = EVM.Fetch.makeContractFromRPC <$> sessionCache.contractCache
164-
forM_ (Map.toList contractsCache) $ \(addr, contract) -> do
165-
r <- externalSolcContract env addr contract
166-
case r of
167-
Just (externalSourceCache, solcContract) -> do
168-
let dir' = dir </> show addr
169-
saveCoverages env
170-
runId
171-
dir'
172-
externalSourceCache
173-
[solcContract]
174-
Nothing -> pure ()
133+
-- coverage reports for external contracts
134+
-- Get contracts from hevm session cache
135+
sessionCache <- readMVar env.fetchSession.sharedCache
136+
explorerUrl <- Etherscan.getBlockExplorerUrl env.chainId
137+
let contractsCache = EVM.Fetch.makeContractFromRPC <$> sessionCache.contractCache
138+
forM_ (Map.toList contractsCache) $ \(addr, contract) -> do
139+
r <- externalSolcContract env explorerUrl addr contract
140+
case r of
141+
Just (externalSourceCache, solcContract) -> do
142+
let dir' = dir </> show addr
143+
saveCoverages env
144+
runId
145+
dir'
146+
externalSourceCache
147+
[solcContract]
148+
Nothing -> pure ()
175149

176150
fetchChainIdFrom :: Maybe Text -> IO (Maybe W256)
177151
fetchChainIdFrom (Just url) = do

‎lib/Echidna/Types/Cache.hs‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,6 @@ module Echidna.Types.Cache where
33
import Data.Map (Map)
44
import Data.Text (Text)
55

6-
import EVM.Types (W256, Addr, Contract)
6+
import EVM.Types (W256)
77

8-
type ContractCache = Map Addr (Maybe Contract)
9-
type SlotCache = Map Addr (Map W256 (Maybe W256))
10-
type ContractNameCache = Map W256 Text
8+
type ContractNameCache = Map W256 Text

‎lib/Etherscan.hs‎

Lines changed: 81 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,58 @@
1-
module Etherscan where
1+
module Etherscan
2+
( SourceCode(..)
3+
, getBlockExplorerUrl
4+
, fetchContractSource
5+
, fetchContractSourceMap
6+
)
7+
where
28

39
import Control.Concurrent (threadDelay)
410
import Control.Exception (catch, SomeException)
511
import Control.Monad
612
import Data.Aeson
713
import Data.Aeson.Types (parseEither)
8-
import Data.Maybe (catMaybes)
14+
import Data.Map.Strict (Map)
15+
import Data.Map.Strict qualified as Map
16+
import Data.Maybe (catMaybes, fromMaybe)
917
import Data.Sequence (Seq)
1018
import Data.Text (Text)
1119
import Data.Text qualified as T
20+
import GHC.Generics (Generic)
1221
import Network.HTTP.Simple (httpSink, parseRequest, getResponseBody, httpJSON)
1322
import Text.HTML.DOM (sinkDoc)
23+
import Text.Read (readMaybe)
1424
import Text.XML.Cursor (attributeIs, content, element, fromDocument, ($//), (&//))
1525

1626
import EVM.Solidity (makeSrcMaps, SrcMap)
17-
import EVM.Types (Addr)
27+
import EVM.Types (Addr, W256)
1828

1929
data SourceCode = SourceCode
2030
{ name :: Text
2131
, code :: String
2232
}
2333
deriving Show
2434

25-
fetchContractSource :: Maybe Text -> Addr -> IO (Maybe SourceCode)
26-
fetchContractSource apiKey addr = do
35+
data ChainInfo = ChainInfo
36+
{ chainname :: Text
37+
, chainid :: Text
38+
, blockexplorer :: Text
39+
, apiurl :: Text
40+
, status :: Int
41+
} deriving (Show, Generic)
42+
43+
instance FromJSON ChainInfo
44+
45+
newtype ChainlistResponse = ChainlistResponse
46+
{ result :: [ChainInfo]
47+
} deriving (Show, Generic)
48+
49+
instance FromJSON ChainlistResponse
50+
51+
fetchContractSource :: Maybe W256 -> Maybe Text -> Addr -> IO (Maybe SourceCode)
52+
fetchContractSource chainId apiKey addr = do
53+
let chainParam = maybe "chainid=1" (\c -> "chainid=" <> show (fromIntegral c :: Integer)) chainId
2754
url <- parseRequest $ "https://api.etherscan.io/v2/api?"
28-
<> "&chainid=1"
55+
<> chainParam
2956
<> "&module=contract"
3057
<> "&action=getsourcecode"
3158
<> "&address=" <> show addr
@@ -60,12 +87,57 @@ fetchContractSource apiKey addr = do
6087
try url (n - 1)
6188
_ -> pure Nothing
6289

90+
-- | Fetch the chainlist from Etherscan API and return a map of chainId to block explorer URL
91+
fetchChainlist :: IO (Maybe (Map W256 Text))
92+
fetchChainlist = do
93+
putStr "Fetching Etherscan chainlist... "
94+
url <- parseRequest "https://api.etherscan.io/v2/chainlist"
95+
try url (3 :: Int)
96+
where
97+
try url n = catch
98+
(do
99+
resp <- httpJSON url
100+
let result = getResponseBody resp :: ChainlistResponse
101+
putStrLn "Success!"
102+
let chainMap = Map.fromList
103+
[ (cid, T.dropWhileEnd (== '/') ci.blockexplorer)
104+
| ci <- result.result
105+
, ci.status == 1 -- Only active chains
106+
, Just cid <- [readMaybe $ T.unpack ci.chainid]
107+
]
108+
pure $ Just chainMap
109+
)
110+
(\(e :: SomeException) -> do
111+
if n > 0
112+
then do
113+
putStrLn $ "Retrying (" <> show n <> " left). Error: " <> show e
114+
threadDelay 1000000 -- 1 second
115+
try url (n - 1)
116+
else do
117+
putStrLn $ "Failed: " <> show e
118+
pure Nothing
119+
)
120+
121+
-- | Get block explorer URL for a chainId
122+
getBlockExplorerUrl :: Maybe W256 -> IO String
123+
getBlockExplorerUrl maybeChainId = do
124+
let chainId = fromMaybe 1 maybeChainId
125+
maybeChainlist <- fetchChainlist
126+
let chainlist = fromMaybe Map.empty maybeChainlist
127+
case Map.lookup chainId chainlist of
128+
Nothing -> do
129+
putStrLn $ "Warning: No block explorer found for chainId "
130+
<> show (fromIntegral chainId :: Integer) <> ", defaulting to mainnet"
131+
pure "https://etherscan.io"
132+
Just url -> pure $ T.unpack url
133+
63134
-- | Unfortunately, Etherscan doesn't expose source maps in the JSON API.
64135
-- This function scrapes it from the HTML. Return a tuple where the first element
65136
-- is raw srcmap in text format and the second element is a parsed map.
66-
fetchContractSourceMap :: Addr -> IO (Maybe (Text, Seq SrcMap))
67-
fetchContractSourceMap addr = do
68-
url <- parseRequest $ "https://etherscan.io/address/" <> show addr
137+
fetchContractSourceMap :: String -> Addr -> IO (Maybe (Text, Seq SrcMap))
138+
fetchContractSourceMap baseUrl addr = do
139+
-- Scrape HTML from block explorer
140+
url <- parseRequest $ baseUrl <> "/address/" <> show addr
69141
doc <- httpSink url $ const sinkDoc
70142
let cursor = fromDocument doc
71143
-- reverse to start looking from the end

0 commit comments

Comments
 (0)