Skip to content

Commit 5fd1eed

Browse files
elopezelopez
committed
etherscan: add support for source maps on other chains
1 parent 46abdfb commit 5fd1eed

File tree

5 files changed

+89
-10
lines changed

5 files changed

+89
-10
lines changed

‎lib/Echidna.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -129,9 +129,10 @@ mkEnv cfg buildOutput tests world slitherInfo = do
129129
testRefs <- traverse newIORef tests
130130
fetchSession <- EVM.Fetch.mkSession cfg.campaignConf.corpusDir (fromIntegral <$> cfg.rpcBlock)
131131
contractNameCache <- newIORef mempty
132+
chainlistCache <- newIORef Nothing
132133
-- TODO put in real path
133134
let dapp = dappInfo "/" buildOutput
134-
pure $ Env { cfg, dapp, codehashMap, fetchSession, contractNameCache
135+
pure $ Env { cfg, dapp, codehashMap, fetchSession, contractNameCache, chainlistCache
135136
, chainId, eventQueue, coverageRefInit, coverageRefRuntime, corpusRef, testRefs, world
136137
, slitherInfo
137138
}

‎lib/Echidna/Onchain.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,7 @@ externalSolcContract env addr c = do
123123
srcRet <- Etherscan.fetchContractSource env.chainId env.cfg.etherscanApiKey addr
124124
putStrLn $ if isJust srcRet then "Success!" else "Error!"
125125
putStr $ "Fetching Solidity source map for contract at address " <> show addr <> "... "
126-
srcmapRet <- Etherscan.fetchContractSourceMap addr
126+
srcmapRet <- Etherscan.fetchContractSourceMap env.chainlistCache env.chainId addr
127127
putStrLn $ if isJust srcmapRet then "Success!" else "Error!"
128128
pure $ do
129129
src <- srcRet

‎lib/Echidna/Types/Cache.hs‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,7 @@ 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
9+
type ChainlistCache = Map W256 Text

‎lib/Echidna/Types/Config.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,7 @@ data Env = Env
8383
, codehashMap :: CodehashMap
8484
, fetchSession :: Fetch.Session
8585
, contractNameCache :: IORef ContractNameCache
86+
, chainlistCache :: IORef (Maybe ChainlistCache)
8687
, chainId :: Maybe W256
8788
, world :: World
8889
}

‎lib/Etherscan.hs‎

Lines changed: 82 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -5,12 +5,17 @@ import Control.Exception (catch, SomeException)
55
import Control.Monad
66
import Data.Aeson
77
import Data.Aeson.Types (parseEither)
8+
import Data.IORef (IORef, atomicWriteIORef, readIORef)
9+
import Data.Map.Strict (Map)
10+
import Data.Map.Strict qualified as Map
811
import Data.Maybe (catMaybes)
912
import Data.Sequence (Seq)
1013
import Data.Text (Text)
1114
import Data.Text qualified as T
15+
import GHC.Generics (Generic)
1216
import Network.HTTP.Simple (httpSink, parseRequest, getResponseBody, httpJSON)
1317
import Text.HTML.DOM (sinkDoc)
18+
import Text.Read (readMaybe)
1419
import Text.XML.Cursor (attributeIs, content, element, fromDocument, ($//), (&//))
1520

1621
import EVM.Solidity (makeSrcMaps, SrcMap)
@@ -22,9 +27,25 @@ data SourceCode = SourceCode
2227
}
2328
deriving Show
2429

30+
data ChainInfo = ChainInfo
31+
{ chainname :: Text
32+
, chainid :: Text
33+
, blockexplorer :: Text
34+
, apiurl :: Text
35+
, status :: Int
36+
} deriving (Show, Generic)
37+
38+
instance FromJSON ChainInfo
39+
40+
newtype ChainlistResponse = ChainlistResponse
41+
{ result :: [ChainInfo]
42+
} deriving (Show, Generic)
43+
44+
instance FromJSON ChainlistResponse
45+
2546
fetchContractSource :: Maybe W256 -> Maybe Text -> Addr -> IO (Maybe SourceCode)
2647
fetchContractSource chainId apiKey addr = do
27-
let chainParam = maybe "&chainid=1" (\c -> "&chainid=" <> show c) chainId
48+
let chainParam = maybe "&chainid=1" (\c -> "&chainid=" <> show (fromIntegral c :: Integer)) chainId
2849
url <- parseRequest $ "https://api.etherscan.io/v2/api?"
2950
<> chainParam
3051
<> "&module=contract"
@@ -61,12 +82,69 @@ fetchContractSource chainId apiKey addr = do
6182
try url (n - 1)
6283
_ -> pure Nothing
6384

85+
-- | Fetch the chainlist from Etherscan API and return a map of chainId to block explorer URL
86+
fetchChainlist :: IO (Maybe (Map W256 Text))
87+
fetchChainlist = do
88+
putStr "Fetching Etherscan chainlist... "
89+
url <- parseRequest "https://api.etherscan.io/v2/chainlist"
90+
try url (3 :: Int)
91+
where
92+
try url n = catch
93+
(do
94+
resp <- httpJSON url
95+
let result = getResponseBody resp :: ChainlistResponse
96+
putStrLn "Success!"
97+
let chainMap = Map.fromList
98+
[ (cid, T.dropWhileEnd (== '/') ci.blockexplorer)
99+
| ci <- result.result
100+
, ci.status == 1 -- Only active chains
101+
, Just cid <- [readMaybe $ T.unpack ci.chainid]
102+
]
103+
pure $ Just chainMap
104+
)
105+
(\(e :: SomeException) -> do
106+
if n > 0
107+
then do
108+
putStrLn $ "Retrying (" <> show n <> " left). Error: " <> show e
109+
threadDelay 1000000 -- 1 second
110+
try url (n - 1)
111+
else do
112+
putStrLn $ "Failed: " <> show e
113+
pure Nothing
114+
)
115+
116+
-- | Get block explorer URL for a chainId, fetching and caching chainlist if needed
117+
getBlockExplorerUrl :: IORef (Maybe (Map W256 Text)) -> W256 -> IO (Maybe Text)
118+
getBlockExplorerUrl cacheRef chainId = do
119+
cacheVal <- readIORef cacheRef
120+
case cacheVal of
121+
Just cache -> pure $ Map.lookup chainId cache
122+
Nothing -> do
123+
-- Fetch and populate cache (done at most once)
124+
maybeChainlist <- fetchChainlist
125+
atomicWriteIORef cacheRef maybeChainlist
126+
pure $ maybeChainlist >>= Map.lookup chainId
127+
64128
-- | Unfortunately, Etherscan doesn't expose source maps in the JSON API.
65129
-- This function scrapes it from the HTML. Return a tuple where the first element
66130
-- is raw srcmap in text format and the second element is a parsed map.
67-
fetchContractSourceMap :: Addr -> IO (Maybe (Text, Seq SrcMap))
68-
fetchContractSourceMap addr = do
69-
url <- parseRequest $ "https://etherscan.io/address/" <> show addr
131+
fetchContractSourceMap :: IORef (Maybe (Map W256 Text)) -> Maybe W256 -> Addr -> IO (Maybe (Text, Seq SrcMap))
132+
fetchContractSourceMap cacheRef chainId addr = do
133+
-- Determine block explorer URL
134+
let defaultUrl = "https://etherscan.io"
135+
baseUrl <- case chainId of
136+
Nothing -> pure defaultUrl
137+
Just cid -> do
138+
maybeUrl <- getBlockExplorerUrl cacheRef cid
139+
case maybeUrl of
140+
Just url -> pure $ T.unpack url
141+
Nothing -> do
142+
putStrLn $ "Warning: No block explorer found for chainId "
143+
<> show (fromIntegral cid :: Integer) <> ", defaulting to mainnet"
144+
pure defaultUrl
145+
146+
-- Scrape HTML from block explorer
147+
url <- parseRequest $ baseUrl <> "/address/" <> show addr
70148
doc <- httpSink url $ const sinkDoc
71149
let cursor = fromDocument doc
72150
-- reverse to start looking from the end

0 commit comments

Comments
 (0)