ethereum-analyzer-cli 3.2.0 → 3.3.0
raw patch · 3 files changed
+37/−49 lines, 3 files
Files
- ethereum-analyzer-cli.cabal +2/−2
- src/Ethereum/Executable/Analyze.hs +20/−18
- src/Ethereum/Jsonrpc/Client.hs +15/−29
ethereum-analyzer-cli.cabal view
@@ -1,5 +1,5 @@ name: ethereum-analyzer-cli-version: 3.2.0+version: 3.3.0 synopsis: A CLI frontend for ethereum-analyzer. homepage: https://github.com/zchn/ethereum-analyzer license: Apache-2.0@@ -21,7 +21,7 @@ source-repository this type: git location: https://github.com/zchn/ethereum-analyzer- tag: v3.2.0+ tag: v3.3.0 subdir: ethereum-analyzer-cli library
src/Ethereum/Executable/Analyze.hs view
@@ -36,7 +36,7 @@ textOption (long "workDir" <> value "work" <> metavar "PATH" <> help "Path to the work directory (for outputs and intermediate files).") <*>- switch (long "debug" <> help "Whether to print debug info")+ switch (long "debug" <> help "Whether to print debug info") analyzeMain :: IO () analyzeMain = analyze =<< execParser opts@@ -52,20 +52,20 @@ analyze :: AnalyzeFlags -> IO () analyze flags@AnalyzeFlags { astJson = theAstJson , workDir = theWorkDir- , debug = debug} = do+ , debug = _debug+ } = do tmpDirname <- getTmpDirname let sessionDir = toS theWorkDir </> toS tmpDirname createDirectoryIfMissing True sessionDir- when debug $ putText $ show flags+ when _debug $ putText $ show flags content <- if theAstJson == "" || theAstJson == "-" then getContents else readFile $ toS theAstJson case decodeContracts content of Right contracts -> do- savePrettyContracts contracts (toS $- sessionDir </> "contracts.ir")- when debug $ pprintContracts contracts+ savePrettyContracts contracts (toS $ sessionDir </> "contracts.ir")+ when _debug $ pprintContracts contracts saveCfgs contracts (toS $ sessionDir </> "cfgs") putText "Findings: \n" putText ("\n" `T.intercalate` concatMap findingsFor contracts)@@ -75,24 +75,26 @@ getTmpDirname :: IO Text getTmpDirname = do t <- getCurrentTime- let formated = formatTime defaultTimeLocale (- iso8601DateFormat (Just "%H:%M:%S")) t+ let formated =+ formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) t return $ toS formated savePrettyContracts :: [Contract] -> Text -> IO ()-savePrettyContracts cs filepath =- writeFile (toS filepath) (prettyContracts cs)+savePrettyContracts cs filepath = writeFile (toS filepath) (prettyContracts cs) saveCfgs :: [Contract] -> Text -> IO () saveCfgs cs dirpath = do createDirectoryIfMissing True (toS dirpath) let hcs = runSimpleUniqueMonad $ mapM hoopleOf cs- mapM writeContractCfgs hcs+ _ <- mapM writeContractCfgs hcs return ()- where writeContractCfgs hc = do- mapM (writeFunCfgs (toS dirpath </> toS (hcName hc))) (hcFunctions hc)- return ()- writeFunCfgs contractPrefix hf = do- let dot = toDotText (hfCFG hf)- writeFile (contractPrefix <.> (toS $ unIdfr $ hfName hf)- <.> "CFG" <.> ".dot") dot+ where+ writeContractCfgs hc = do+ _ <-+ mapM (writeFunCfgs (toS dirpath </> toS (hcName hc))) (hcFunctions hc)+ return ()+ writeFunCfgs contractPrefix hf = do+ let dot = toDotText (hfCFG hf)+ writeFile+ (contractPrefix <.> (toS $ unIdfr $ hfName hf) <.> "CFG" <.> ".dot")+ dot
src/Ethereum/Jsonrpc/Client.hs view
@@ -39,9 +39,7 @@ Text deriving (Show, Eq) -parseJSONElemAtIndex- :: FromJSON a- => Int -> V.Vector Value -> Parser a+parseJSONElemAtIndex :: FromJSON a => Int -> V.Vector Value -> Parser a parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx) instance FromRequest Req where@@ -100,11 +98,11 @@ toJSON (Eth_getCodeReq addr blk) = toJSON (addr, blk) data Res- = Web3_clientVersionRes { clientVersion :: Text}- | Eth_blockNumberRes { blockNumber :: Text}- | Eth_getBlockByNumberRes { blockInfo :: Object}- | Eth_getTransactionReceiptRes { txReceipt :: Object}- | Eth_getCodeRes { code :: Text}+ = Web3_clientVersionRes { clientVersion :: Text }+ | Eth_blockNumberRes { blockNumber :: Text }+ | Eth_getBlockByNumberRes { blockInfo :: Object }+ | Eth_getTransactionReceiptRes { txReceipt :: Object }+ | Eth_getCodeRes { code :: Text } deriving (Show, Eq) instance FromResponse Res where@@ -126,9 +124,7 @@ toJSON (Eth_getTransactionReceiptRes result) = toJSON result toJSON (Eth_getCodeRes codeRes) = toJSON codeRes -callJsonRpc- :: (MonadIO m, MonadCatch m)- => String -> Int -> Req -> m Res+callJsonRpc :: (MonadIO m, MonadCatch m) => String -> Int -> Req -> m Res callJsonRpc server port req = do initReq <- NHC.parseUrl ("http://" ++ server ++ ":" ++ show port) let requ =@@ -148,30 +144,24 @@ 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 :: (MonadIO m, MonadCatch m) => String -> Int -> m Text web3ClientVersion server port = clientVersion <$> callJsonRpc server port Web3_clientVersionReq -ethBlockNumber- :: (MonadIO m, MonadCatch m)- => String -> Int -> m Text+ethBlockNumber :: (MonadIO m, MonadCatch m) => String -> Int -> m Text ethBlockNumber server port = blockNumber <$> callJsonRpc server port Eth_blockNumberReq -ethGetTransactionsByBlockNumber- :: (MonadIO m, MonadCatch m)- => String -> Int -> Text -> m [Text]+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") . blockInfo <$> callJsonRpc server port (Eth_getBlockByNumberReq blk False) -ethGetContractAddrByTxHash- :: (MonadIO m, MonadCatch m)- => String -> Int -> Text -> m (Maybe Text)+ethGetContractAddrByTxHash ::+ (MonadIO m, MonadCatch m) => String -> Int -> Text -> m (Maybe Text) ethGetContractAddrByTxHash server port txhash = ((\ares -> case ares of@@ -185,15 +175,11 @@ txReceipt <$> callJsonRpc server port (Eth_getTransactionReceiptReq txhash) -ethGetCode- :: (MonadIO m, MonadCatch m)- => String -> Int -> Text -> m Text+ethGetCode :: (MonadIO m, MonadCatch m) => String -> Int -> Text -> m Text ethGetCode server port address = code <$> callJsonRpc server port (Eth_getCodeReq address "latest") -getCode- :: (MonadIO m, MonadCatch m)- => String -> Int -> Text -> m Code+getCode :: (MonadIO m, MonadCatch m) => String -> Int -> Text -> m Code getCode server port address = do textCode <- ethGetCode server port address return $