diff --git a/ethereum-analyzer-cli.cabal b/ethereum-analyzer-cli.cabal --- a/ethereum-analyzer-cli.cabal +++ b/ethereum-analyzer-cli.cabal @@ -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 diff --git a/exec_src/AnalyzeMain.hs b/exec_src/AnalyzeMain.hs new file mode 100644 --- /dev/null +++ b/exec_src/AnalyzeMain.hs @@ -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 () diff --git a/exec_src/DumpCodeMain.hs b/exec_src/DumpCodeMain.hs --- a/exec_src/DumpCodeMain.hs +++ b/exec_src/DumpCodeMain.hs @@ -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 diff --git a/src/Ethereum/Executable/DumpCodeMain.hs b/src/Ethereum/Executable/DumpCodeMain.hs --- a/src/Ethereum/Executable/DumpCodeMain.hs +++ b/src/Ethereum/Executable/DumpCodeMain.hs @@ -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) diff --git a/src/Ethereum/Jsonrpc/Client.hs b/src/Ethereum/Jsonrpc/Client.hs --- a/src/Ethereum/Jsonrpc/Client.hs +++ b/src/Ethereum/Jsonrpc/Client.hs @@ -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)