ethereum-analyzer-cli 1.3.0 → 2.0.0
raw patch · 5 files changed
+130/−66 lines, 5 filesdep +optparse-applicativedep +optparse-textnew-component:exe:ea-analyze
Dependencies added: optparse-applicative, optparse-text
Files
- ethereum-analyzer-cli.cabal +26/−6
- exec_src/AnalyzeMain.hs +48/−0
- exec_src/DumpCodeMain.hs +3/−4
- src/Ethereum/Executable/DumpCodeMain.hs +5/−9
- src/Ethereum/Jsonrpc/Client.hs +48/−47
ethereum-analyzer-cli.cabal view
@@ -1,5 +1,5 @@ name: ethereum-analyzer-cli-version: 1.3.0+version: 2.0.0 synopsis: A CLI frontend for ethereum-analyzer. homepage: https://github.com/ethereumK/ethereum-analyzer license: Apache-2.0@@ -21,7 +21,7 @@ source-repository this type: git location: https://github.com/zchn/ethereum-analyzer- tag: v1.3.0+ tag: v2.0.0 subdir: ethereum-analyzer-cli library@@ -51,25 +51,45 @@ hs-source-dirs: src buildable: True default-language: Haskell98- default-extensions: OverloadedStrings+ default-extensions: NoImplicitPrelude+ , OverloadedStrings -executable ea-dump-contract- main-is: DumpCodeMain.hs+executable ea-analyze+ main-is: AnalyzeMain.hs build-depends: base >= 4 && < 5+ , ethereum-analyzer , ethereum-analyzer-cli , ethereum-analyzer-deps- , hflags , monad-logger+ , optparse-applicative+ , optparse-text , protolude+ , text ghc-options: -Wall hs-source-dirs: exec_src buildable: True default-language: Haskell98+ default-extensions: NoImplicitPrelude+ , OverloadedStrings+ , DeriveGeneric executable ea-bytecode-vis main-is: BytecodeVisMain.hs build-depends: base >= 4 && < 5 , ethereum-analyzer-cli+ , hflags+ , monad-logger+ , protolude+ ghc-options: -Wall+ hs-source-dirs: exec_src+ buildable: True+ default-language: Haskell98++executable ea-dump-contract+ main-is: DumpCodeMain.hs+ build-depends: base >= 4 && < 5+ , ethereum-analyzer-cli+ , ethereum-analyzer-deps , hflags , monad-logger , protolude
+ exec_src/AnalyzeMain.hs view
@@ -0,0 +1,48 @@+module Main+ ( main+ ) where++import Protolude++import qualified Data.Text as T++import Ethereum.Analyzer.Debug+import Ethereum.Analyzer.Solidity++import Options.Applicative+import Options.Applicative.Text++data AnalyzeFlags = AnalyzeFlags+ { astJson :: Text+ , debug :: Bool+ } deriving (Eq, Show)++analyzeFlags :: Parser AnalyzeFlags+analyzeFlags =+ AnalyzeFlags <$>+ textOption+ (long "astJson" <> metavar "PATH" <> help "Path to the ast-json file.") <*>+ switch (long "debug" <> help "Whether to print debug info")++main :: IO ()+main = analyze =<< execParser opts+ where+ opts =+ info+ (analyzeFlags <**> helper)+ (fullDesc <>+ progDesc (toS ("Analyze the contract specified at PATH" :: Text)) <>+ header+ (toS ("ea-analyze - CLI interface for ethereum-analyzer" :: Text)))++analyze :: AnalyzeFlags -> IO ()+analyze flags@AnalyzeFlags {astJson = theAstJson} = do+ putText $ show flags+ content <- readFile $ toS theAstJson+ case decodeContracts content of+ Right contracts -> do+ pprintContracts contracts+ putText "Findins: \n"+ putText ("\n" `T.intercalate` concatMap findingsFor contracts)+ Left err -> putText err+ return ()
exec_src/DumpCodeMain.hs view
@@ -7,8 +7,8 @@ ) where import Blockchain.Output-import Ethereum.Executable.DumpCodeMain import Control.Monad.Logger+import Ethereum.Executable.DumpCodeMain import HFlags defineFlag@@ -29,7 +29,6 @@ main = do s <- $initHFlags "ea-dump-contract" putStrLn $ "Flags: " ++ show s- flip- runLoggingT- printLogMsg+ runLoggingT (dumpContracts flags_jrpcServer flags_jrpcPort flags_contractDir)+ printLogMsg
src/Ethereum/Executable/DumpCodeMain.hs view
@@ -6,11 +6,13 @@ ( dumpContracts ) where -import Ethereum.Jsonrpc.Client+import Prelude+ import Control.Monad.Logger import Control.Monad.Trans import Data.Maybe import Data.Text as T hiding (map)+import Ethereum.Jsonrpc.Client import Numeric import System.Directory as SD @@ -22,7 +24,7 @@ latest_bNum <- ethBlockNumber server port let parsed_bns = readHex $ Prelude.drop 2 $ T.unpack latest_bNum $logInfo $ T.pack $ "parsing block number: " ++ show parsed_bns- let latest_bn = fst $ Prelude.head $ parsed_bns+ let latest_bn = fst $ Prelude.head parsed_bns $logInfo $ T.pack $ "block number is " ++ show latest_bn enumerateContractAt server port contractDir latest_bn return ()@@ -32,9 +34,7 @@ enumerateContractAt s p contractDir bn = do $logInfo $ T.pack $ "processing block " ++ show bn transactions <- ethGetTransactionsByBlockNumber s p (T.pack $ show bn)- -- $logInfo $ T.pack $ "transactions: " ++ show transactions addresses <- catMaybes <$> mapM (ethGetContractAddrByTxHash s p) transactions- -- $logInfo $ T.pack $ "addresses: " ++ show addresses mapM_ (\addr -> do let fpath = contractDir ++ "/" ++ T.unpack addr ++ ".contract"@@ -43,10 +43,6 @@ then $logInfo $ T.pack $ "skipping: " ++ show addr else do textCode <- ethGetCode s p addr- lift $ writeFile fpath $ T.unpack $ T.drop 2 textCode- -- $logInfo $ T.append "textCode is " textCode- )+ lift $ writeFile fpath $ T.unpack $ T.drop 2 textCode) addresses- -- code <- getCode server port "0xde0B295669a9FD93d5F28D9Ec85E40f4cb697BAe"- -- $logInfo $ T.pack $ "disasmd code is " ++ formatCode code enumerateContractAt s p contractDir (bn - 1)
src/Ethereum/Jsonrpc/Client.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-} module Ethereum.Jsonrpc.Client ( web3ClientVersion@@ -10,19 +10,21 @@ , getCode ) where +import Prelude+ import Blockchain.Data.Code as BDC import Conduit import Control.Monad.Catch import Data.Aeson import Data.Aeson.Types hiding (Error)+import qualified Data.ByteString.Char8 as DBC import Data.Foldable as DF import Data.HashMap.Strict as DHS import Data.HexString import Data.Text as T+import qualified Data.Vector as V import Network.HTTP.Conduit as NHC hiding (port) import Network.JsonRpc as NJ-import qualified Data.ByteString.Char8 as DBC-import qualified Data.Vector as V data Req = Web3_clientVersionReq@@ -47,42 +49,39 @@ parseParams "eth_blockNumber" = Just $ const $ return Eth_blockNumberReq parseParams "eth_getBlockByNumber" = Just $- withArray "(blockNumber, returnFullTransation)" $- \ab ->- let n = V.length ab- in if n == 2- then do- bn <- parseJSONElemAtIndex 0 ab- full <- parseJSONElemAtIndex 1 ab- return $ Eth_getBlockByNumberReq bn full- else fail $- "cannot unpack array of length " ++- show n ++ " into a Eth_getBlockByNumberReq"+ withArray "(blockNumber, returnFullTransation)" $ \ab ->+ let n = V.length ab+ in if n == 2+ then do+ bn <- parseJSONElemAtIndex 0 ab+ full <- parseJSONElemAtIndex 1 ab+ return $ Eth_getBlockByNumberReq bn full+ else fail $+ "cannot unpack array of length " +++ show n ++ " into a Eth_getBlockByNumberReq" parseParams "eth_getTransactionReceipt" = Just $- withArray "(txHash)" $- \ab ->- let n = V.length ab- in if n == 1- then do- txhash <- parseJSONElemAtIndex 0 ab- return $ Eth_getTransactionReceiptReq txhash- else fail $- "cannot unpack array of length " ++- show n ++ " into a Eth_getTransactionReceiptReq"+ withArray "(txHash)" $ \ab ->+ let n = V.length ab+ in if n == 1+ then do+ txhash <- parseJSONElemAtIndex 0 ab+ return $ Eth_getTransactionReceiptReq txhash+ else fail $+ "cannot unpack array of length " +++ show n ++ " into a Eth_getTransactionReceiptReq" parseParams "eth_getCode" = Just $- withArray "(address, blockNum)" $- \ab ->- let n = V.length ab- in if n == 2- then do- addr <- parseJSONElemAtIndex 0 ab- blk <- parseJSONElemAtIndex 1 ab- return $ Eth_getCodeReq addr blk- else fail $- "cannot unpack array of length " ++- show n ++ " into a Eth_getCodeReq"+ withArray "(address, blockNum)" $ \ab ->+ let n = V.length ab+ in if n == 2+ then do+ addr <- parseJSONElemAtIndex 0 ab+ blk <- parseJSONElemAtIndex 1 ab+ return $ Eth_getCodeReq addr blk+ else fail $+ "cannot unpack array of length " +++ show n ++ " into a Eth_getCodeReq" parseParams _ = Nothing instance ToRequest Req where@@ -131,14 +130,14 @@ :: (MonadIO m, MonadCatch m) => String -> Int -> Req -> m Res callJsonRpc server port req = do- initReq <- NHC.parseUrl ("http://" ++ server ++ ":" ++ (show port))+ initReq <- NHC.parseUrl ("http://" ++ server ++ ":" ++ show port) let requ = initReq { NHC.method = "POST" , NHC.requestHeaders =- ("Content-Type", "application/json") : NHC.requestHeaders initReq+ ("Content-Type", "application/json") : NHC.requestHeaders initReq , NHC.requestBody =- RequestBodyLBS $ encode $ toJSON (NJ.buildRequest V2 req (IdInt 1))+ RequestBodyLBS $ encode $ toJSON (NJ.buildRequest V2 req (IdInt 1)) } manager <- liftIO $ newManager tlsManagerSettings resp <- NHC.httpLbs requ manager@@ -146,25 +145,27 @@ Just body -> case fromResponse (requestMethod req) body of Just res -> return res- Nothing -> error $ "couldn't parse json-rpc response: " ++ (show resp)- Nothing -> error $ "couldn't parse json: " ++ (show resp)+ Nothing -> error $ "couldn't parse json-rpc response: " ++ show resp+ Nothing -> error $ "couldn't parse json: " ++ show resp web3ClientVersion :: (MonadIO m, MonadCatch m) => String -> Int -> m Text-web3ClientVersion server port = clientVersion <$> callJsonRpc server port Web3_clientVersionReq+web3ClientVersion server port =+ clientVersion <$> callJsonRpc server port Web3_clientVersionReq ethBlockNumber :: (MonadIO m, MonadCatch m) => String -> Int -> m Text-ethBlockNumber server port = blockNumber <$> callJsonRpc server port Eth_blockNumberReq+ethBlockNumber server port =+ blockNumber <$> callJsonRpc server port Eth_blockNumberReq ethGetTransactionsByBlockNumber :: (MonadIO m, MonadCatch m) => String -> Int -> Text -> m [Text] ethGetTransactionsByBlockNumber server port blk =- (Prelude.map $ \(String s) -> s) <$> (\(Array a) -> DF.toList $ a) <$>- (lookupDefault (Array $ V.singleton (String "error")) "transactions") <$>+ (Prelude.map (\(String s) -> s) . (\(Array a) -> DF.toList a) <$>+ lookupDefault (Array $ V.singleton (String "error")) "transactions") . blockInfo <$> callJsonRpc server port (Eth_getBlockByNumberReq blk False) @@ -172,7 +173,7 @@ :: (MonadIO m, MonadCatch m) => String -> Int -> Text -> m (Maybe Text) ethGetContractAddrByTxHash server port txhash =- (\ares ->+ ((\ares -> case ares of (String a) -> if toLower a == "null"@@ -180,7 +181,7 @@ else Just a Null -> Nothing other -> error $ show other) <$>- (lookupDefault (String "error") "contractAddress") <$>+ lookupDefault (String "error") "contractAddress") . txReceipt <$> callJsonRpc server port (Eth_getTransactionReceiptReq txhash) @@ -188,7 +189,7 @@ :: (MonadIO m, MonadCatch m) => String -> Int -> Text -> m Text ethGetCode server port address =- fmap code $ callJsonRpc server port (Eth_getCodeReq address "latest")+ code <$> callJsonRpc server port (Eth_getCodeReq address "latest") getCode :: (MonadIO m, MonadCatch m)