/metrics- Source code at https://github.com/ethereumK/ethereum-analyzer/ -
- - - |] diff --git a/src/Blockchain/Analyze/Servant/API/Internal.hs b/src/Blockchain/Analyze/Servant/API/Internal.hs deleted file mode 100644 --- a/src/Blockchain/Analyze/Servant/API/Internal.hs +++ /dev/null @@ -1,14 +0,0 @@ --- | Definition of HTML content type. -module Blockchain.Analyze.Servant.API.Internal - ( HTML - ) where - -import Network.HTTP.Media ((//), (/:)) -import Servant.API (Accept(..)) - --- | HTML content type. -data HTML = - HTML - -instance Accept HTML where - contentType _ = "text" // "html" /: ("charset", "utf-8") diff --git a/src/Blockchain/Analyze/Servant/Server.hs b/src/Blockchain/Analyze/Servant/Server.hs deleted file mode 100644 --- a/src/Blockchain/Analyze/Servant/Server.hs +++ /dev/null @@ -1,120 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards - #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DataKinds #-} - --- | Serve the API as an HTTP server. -module Blockchain.Analyze.Servant.Server - ( server - , startApp - ) where - -import Protolude - -import Control.Monad.Log (Severity(..)) -import qualified Data.List as List -import GHC.Stats (getGCStatsEnabled) -import Network.Wai.Handler.Warp - (Port, Settings, defaultSettings, runSettings, setBeforeMainLoop, - setPort) -import qualified Network.Wai.Middleware.RequestLogger as RL -import Options.Applicative - (ParserInfo, auto, eitherReader, execParser, fullDesc, header, - help, helper, info, long, metavar, option, progDesc, switch, value) -import qualified Prometheus as Prom -import qualified Prometheus.Metric.GHC as Prom -import Servant (serve) -import Text.PrettyPrint.Leijen.Text (int, text) - -import Blockchain.Analyze.Servant.API (apiraw) -import Blockchain.Analyze.Servant.Server.Handlers (server) -import Blockchain.Analyze.Servant.Server.Instrument - (defaultPrometheusSettings, prometheus, requestDuration) -import qualified Blockchain.Analyze.Servant.Server.Logging as Log - --- | Configuration for the application. -data Config = Config - { port :: Port - , accessLogs :: AccessLogs - , logLevel :: Severity - , enableGhcMetrics :: Bool - } deriving (Show) - --- | What level of access logs to show. -data AccessLogs - = Disabled -- ^ Don't show access logs. - | Enabled -- ^ Show Apache-style access logs. - | DevMode -- ^ Show detailed, colorful access logs. Not suitable in production. - deriving (Eq, Show) - --- | Run the service. -startApp :: IO () -startApp = runApp =<< execParser options - -options :: ParserInfo Config -options = info (helper <*> parser) description - where - parser = - Config <$> - option auto (fold [long "port", metavar "PORT", help "Port to listen on"]) <*> - option - (eitherReader parseAccessLogs) - (fold - [long "access-logs", help "How to log HTTP access", value Disabled]) <*> - option - (eitherReader - (maybe (throwError (toS invalidLogLevel)) pure . Log.fromKeyword . toS)) - (fold - [ long "log-level" - , help "Minimum severity for log messages" - , value Informational - ]) <*> - switch - (fold - [ long "ghc-metrics" - , help "Export GHC metrics. Requires running with +RTS." - ]) - invalidLogLevel = "Log level must be one of: " <> allLogLevels - allLogLevels = - fold . List.intersperse "," . List.map Log.toKeyword $ enumFrom minBound - parseAccessLogs "none" = pure Disabled - parseAccessLogs "basic" = pure Enabled - parseAccessLogs "dev" = pure DevMode - parseAccessLogs _ = throwError "One of 'none', 'basic', or 'dev'" - description = - fold [fullDesc, progDesc "Ethereum Analyzer", header "ethereum-analyzer"] - -runApp :: Config -> IO () -runApp config@Config {..} = do - requests <- Prom.registerIO requestDuration - when enableGhcMetrics $ - do statsEnabled <- getGCStatsEnabled - unless statsEnabled $ - Log.withLogging logLevel $ - Log.log - Warning - (text - "Exporting GHC metrics but GC stats not enabled. Re-run with +RTS -T.") - void $ Prom.register Prom.ghcMetrics - runSettings settings (middleware requests) - where - settings = warpSettings config - middleware r = - logging . prometheus defaultPrometheusSettings r "ethereum_analyzer" $ app - logging = - case accessLogs of - Disabled -> identity - Enabled -> RL.logStdout - DevMode -> RL.logStdoutDev - app = serve apiraw (server logLevel) - --- | Generate warp settings from config --- --- Serve from a port and print out where we're serving from. -warpSettings :: Config -> Settings -warpSettings Config {..} = - setBeforeMainLoop - (Log.withLogging logLevel printPort) - (setPort port defaultSettings) - where - printPort = Log.log Informational (text "Listening on :" `mappend` int port) diff --git a/src/Blockchain/Analyze/Servant/Server/Handlers.hs b/src/Blockchain/Analyze/Servant/Server/Handlers.hs deleted file mode 100644 --- a/src/Blockchain/Analyze/Servant/Server/Handlers.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeOperators #-} - --- | Implementation of the ethereum-analyzer API. -module Blockchain.Analyze.Servant.Server.Handlers - ( server - ) where - --- XXX: jml doesn't like the name "Handlers" for this, and isn't sure that it --- should be in a submodule of Project.Server. Perhaps the code in --- Project.Server (which is command-line processing, setting up logs & --- monitoring, starting the HTTP server) should be in a different module. -import Protolude hiding (Handler) - -import Blockchain.Analyze.Util -import Blockchain.Analyze.Servant.API - (API, RootPage(..), User(..), Users(..), DotCfgResp(..)) -import qualified Blockchain.Analyze.Servant.Server.Logging as Log -import Control.Monad.Except (ExceptT(..)) -import Control.Monad.Log (Severity, logInfo) -import qualified Data.Text.Lazy as DTL -import Servant - (ServantErr, Server, (:<|>)(..), (:>), (:~>)(..), enter, Raw) -import Servant.Utils.StaticFiles (serveDirectory) -import Text.PrettyPrint.Leijen.Text (Doc, Pretty, text) - --- | ethereum-analyzer API implementation. -server :: Severity -> Server (API :<|> "web" :> Raw) -server logLevel = enter (toHandler logLevel) handlers :<|> serveDirectory "web" - where - handlers = pure RootPage :<|> users :<|> dotcfg :<|> dotcfg2 - --- | Our custom handler type. -type Handler msg = ExceptT ServantErr (Log.LogM msg IO) - --- | Translate our custom monad into a Servant handler. --- --- See http://haskell-servant.readthedocs.io/en/stable/tutorial/Server.html#using-another-monad-for-your-handlers --- for the details. -toHandler - :: Pretty msg - => Severity -> (Handler msg :~> ExceptT ServantErr IO) -toHandler logLevel = Nat toHandler' - where - toHandler' - :: Pretty msg - => Handler msg a -> ExceptT ServantErr IO a - toHandler' = ExceptT . Log.withLogging logLevel . runExceptT - --- | Example endpoint. -users :: Handler Doc Users -users = do - logInfo (text "Example of logging") - pure (Users [User 1 "Isaac" "Newton", User 2 "Albert" "Einstein"]) - -dotcfg :: Maybe Text -> Handler Doc DotCfgResp -dotcfg (Just t) = pure (DotCfgResp (decompileToDotText t) "") -dotcfg _ = pure (DotCfgResp "" "") - -dotcfg2 :: Maybe Text -> Handler Doc DotCfgResp -dotcfg2 (Just t) = pure (uncurry DotCfgResp $ decompileToDotText2 t) -dotcfg2 _ = pure (DotCfgResp "" "") diff --git a/src/Blockchain/Analyze/Servant/Server/Instrument.hs b/src/Blockchain/Analyze/Servant/Server/Instrument.hs deleted file mode 100644 --- a/src/Blockchain/Analyze/Servant/Server/Instrument.hs +++ /dev/null @@ -1,104 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards - #-} - --- | Prometheus instrumentation for ethereum-analyzer. -module Blockchain.Analyze.Servant.Server.Instrument - ( metrics - , requestDuration - , instrumentApp - , prometheus - , PrometheusSettings(..) - , defaultPrometheusSettings - ) where - -import Protolude - -import Data.ByteString.Builder (byteString) -import Data.Time.Clock (diffUTCTime, getCurrentTime) -import qualified Network.HTTP.Types as HTTP -import qualified Network.Wai as Wai -import qualified Prometheus as Prom - --- | Settings that control the behavior of the Prometheus middleware. -data PrometheusSettings = PrometheusSettings - { prometheusEndPoint :: [Text] - -- ^ The path that will be used for exporting metrics. The default value - -- is ["metrics"] which corresponds to the path /metrics. - , prometheusHandlerName :: Maybe Text - -- ^ The name of the handler used to record metrics about the Prometheus - -- endpoint. If Nothing, then we won't record any. - } - --- | Default settings for Prometheus. Serve metrics at /metrics and record --- latency information for that endpoint with 'handler="metrics"'. -defaultPrometheusSettings :: PrometheusSettings -defaultPrometheusSettings = PrometheusSettings ["metrics"] (Just "metrics") - --- | Core information about HTTP requests: --- --- Labels: --- * handler: the name of the application --- * method: the HTTP method requested --- * status_code: the HTTP response code --- --- Actual metric is the latency of the request. -type RequestDuration = Prom.Metric (Prom.Vector Prom.Label3 Prom.Summary) - -requestDuration :: IO RequestDuration -requestDuration = - Prom.vector ("handler", "method", "status_code") $ Prom.summary info Prom.defaultQuantiles - where - info = - Prom.Info - "http_request_duration_seconds" - "The HTTP request latencies in microseconds." - --- | Instrument a WAI app with the default WAI metrics. -instrumentApp - :: RequestDuration -- ^ The metric to instrument - -> Text -- ^ The label used to identify this app - -> Wai.Application -- ^ The app to instrument - -> Wai.Application -- ^ The instrumented app -instrumentApp metric handler app req respond = do - start <- getCurrentTime - app - req - (\res -> do - recordResult start (HTTP.statusCode (Wai.responseStatus res)) - respond res) `onException` - recordResult start (500 :: Integer) - where - recordResult start statusCode = do - end <- getCurrentTime - let latency = fromRational $ toRational (end `diffUTCTime` start) - Prom.withLabel (toS handler, method, status) (Prom.observe latency) metric - where - method = toS (Wai.requestMethod req) - status = show statusCode - --- | Instrument an app with Prometheus and export metrics from the configured --- handler. -prometheus - :: PrometheusSettings -- ^ How we're going to use Prometheus - -> RequestDuration -- ^ A metric to instrument with request information - -> Text -- ^ The label used to identify the app - -> Wai.Middleware -prometheus PrometheusSettings {..} duration appName app req respond = - if Wai.requestMethod req == HTTP.methodGet && Wai.pathInfo req == prometheusEndPoint - then case prometheusHandlerName of - Nothing -> respondWithMetrics respond - Just name -> - instrumentApp duration name (const respondWithMetrics) req respond - else instrumentApp duration appName app req respond - --- | Application that serves the Prometheus /metrics page regardless of what --- was requested. -metrics :: Wai.Application -metrics = const respondWithMetrics - -respondWithMetrics :: (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived -respondWithMetrics respond = do - content <- Prom.exportMetricsAsText - respond $ Wai.responseBuilder HTTP.status200 headers $ byteString content - where - headers = [(HTTP.hContentType, "text/plain; version=0.0.4")] diff --git a/src/Blockchain/Analyze/Servant/Server/Logging.hs b/src/Blockchain/Analyze/Servant/Server/Logging.hs deleted file mode 100644 --- a/src/Blockchain/Analyze/Servant/Server/Logging.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards, - FlexibleContexts #-} - --- | Logging helpers for ethereum-analyzer. -module Blockchain.Analyze.Servant.Server.Logging - ( LogM - , withLogging - , log - , fromKeyword - , toKeyword - ) where - -import Protolude hiding (log) - -import Control.Monad.Catch (MonadMask) -import Control.Monad.Log - (Handler, LoggingT, MonadLog, Severity(..), WithTimestamp(..), - WithSeverity(..), defaultBatchingOptions, logMessage, - mapLogMessageM, renderWithSeverity, renderWithTimestamp, - runLoggingT, timestamp, withFDHandler) -import Data.Time.Format - (defaultTimeLocale, formatTime, iso8601DateFormat) -import Text.PrettyPrint.Leijen.Text (Doc, Pretty(..)) - -type LogM msg m = LoggingT (WithSeverity msg) (LoggingT (WithTimestamp (WithSeverity msg)) m) - --- | Take a bunch of logs with severity and print them to stdout with timestamps. -withLogging - :: (MonadMask m, MonadIO m, Pretty msg) - => Severity -> LogM msg m a -> m a -withLogging severityThreshold body = - withFDHandler defaultBatchingOptions stdout 0.4 80 $ - \stdoutHandler -> - runLoggingT - (withTimestamps body) - (printLogs severityThreshold stdoutHandler) - -withTimestamps - :: (MonadIO m, MonadLog (WithTimestamp msg) m) - => LoggingT msg m a -> m a -withTimestamps = mapLogMessageM timestamp - -type Keyword = Text - -fromKeyword - :: Alternative m - => Keyword -> m Severity -fromKeyword "emerg" = pure Emergency -fromKeyword "alert" = pure Alert -fromKeyword "crit" = pure Critical -fromKeyword "err" = pure Error -fromKeyword "error" = pure Error -fromKeyword "warning" = pure Warning -- A friend in need's a friend indeed. -fromKeyword "warn" = pure Warning -fromKeyword "notice" = pure Notice -fromKeyword "info" = pure Informational -fromKeyword "debug" = pure Debug -fromKeyword _ = empty - -toKeyword :: Severity -> Keyword -toKeyword Emergency = "emerg" -toKeyword Alert = "alert" -toKeyword Critical = "crit" -toKeyword Error = "err" -toKeyword Warning = "warning" -toKeyword Notice = "notice" -toKeyword Informational = "info" -toKeyword Debug = "debug" - -printLogs - :: (Pretty a, MonadIO m) - => Severity -> Handler m Doc -> WithTimestamp (WithSeverity a) -> m () -printLogs severityThreshold handler message = - when (severityThreshold >= msgSeverity (discardTimestamp message)) $ - handler . renderWithTimestamp timeFormatter (renderWithSeverity pretty) $ message - where - timeFormatter = formatTime defaultTimeLocale timeFormat - timeFormat = iso8601DateFormat (Just "%H:%M:%S.%q") - --- | Convenience method to log with severity. -log - :: MonadLog (WithSeverity a) m - => Severity -> a -> m () -log severity msg = logMessage (WithSeverity severity msg) diff --git a/src/Blockchain/Analyze/Util.hs b/src/Blockchain/Analyze/Util.hs deleted file mode 100644 --- a/src/Blockchain/Analyze/Util.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE OverloadedStrings, FlexibleContexts, - OverloadedStrings, FlexibleInstances, GADTs, Rank2Types, - DeriveGeneric, TypeFamilies, UndecidableInstances #-} - -module Blockchain.Analyze.Util - ( toDotText - , decompileToDotText - , decompileToDotText2 - ) where - -import Blockchain.Analyze.Decompile -import Blockchain.Analyze.IR -import Blockchain.Analyze.CfgAugWithTopNPass -import Blockchain.Analyze.CfgAugmentPass -import Compiler.Hoopl -import Data.ByteString.Char8 as DBC -import Data.GraphViz -import Data.GraphViz.Printing -import Data.Graph.Inductive.Graph as DGIG -import Data.Graph.Inductive.PatriciaTree -import Data.Text as DT -import qualified Data.Text.Lazy as DTL - -decompileToDotText :: Text -> Text -decompileToDotText hexcode = - let decompiled = decompileHexString $ DBC.pack $ DT.unpack hexcode - result = - unWordLabelMapM $ - do contract <- evmOps2HplContract decompiled - toDotText <$> (bodyOf . ctorOf <$> doCfgAugmentPass contract) - in result - -decompileToDotText2 :: Text -> (Text, Text) -decompileToDotText2 hexcode = - let hexstring = DBC.pack $ DT.unpack hexcode - result = - unWordLabelMapM $ - do contract' <- doCfgAugWithTopNPass hexstring - return - ( toDotText $ bodyOf (ctorOf contract') - , toDotText $ bodyOf (dispatcherOf contract')) - in result - -toDotText :: HplBody -> Text -toDotText bd = - let bdGr = toGr bd - dotG = toDotGraph bdGr - dotCode = toDot dotG - in DTL.toStrict $ renderDot dotCode - -toGr :: HplBody -> Gr (Block HplOp C C) () -toGr bd = - let lblToNode l = read (Prelude.drop 1 $ show l) - (nList, eList) = - mapFoldWithKey - (\lbl blk (nList', eList') -> - let node = lblToNode lbl - edgs = - Prelude.map (\l -> (node, lblToNode l, ())) (successors blk) - in (nList' ++ [(node, blk)], eList' ++ edgs)) - ([], []) - bd - in mkGraph nList eList - -visParams = - nonClusteredParams - { fmtNode = \(_, nl) -> [toLabel $ show nl, shape BoxShape] - } - -toDotGraph :: Gr (Block HplOp C C) () -> DotGraph Node -toDotGraph gr = graphToDot visParams gr diff --git a/src/Blockchain/Jsonrpc/Client.hs b/src/Blockchain/Jsonrpc/Client.hs deleted file mode 100644 --- a/src/Blockchain/Jsonrpc/Client.hs +++ /dev/null @@ -1,199 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} - -module Blockchain.Jsonrpc.Client - ( web3ClientVersion - , ethBlockNumber - , ethGetTransactionsByBlockNumber - , ethGetContractAddrByTxHash - , ethGetCode - , getCode - ) where - -import Blockchain.Data.Code as BDC -import Conduit -import Control.Monad.Catch -import Data.Aeson -import Data.Aeson.Types hiding (Error) -import Data.Foldable as DF -import Data.HashMap.Strict as DHS -import Data.HexString -import Data.Text as T -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 - | Eth_blockNumberReq - -- blockNumber, returnFullTransation - | Eth_getBlockByNumberReq Text - Bool - -- txHash - | Eth_getTransactionReceiptReq Text - -- codeAddres codeBlockNum - | Eth_getCodeReq Text - Text - deriving (Show, Eq) - -parseJSONElemAtIndex - :: FromJSON a - => Int -> V.Vector Value -> Parser a -parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx) - -instance FromRequest Req where - parseParams "web3_clientVersion" = Just $ const $ return Web3_clientVersionReq - 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" - 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" - 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" - parseParams _ = Nothing - -instance ToRequest Req where - requestMethod Web3_clientVersionReq = "web3_clientVersion" - requestMethod Eth_blockNumberReq = "eth_blockNumber" - requestMethod (Eth_getBlockByNumberReq _ _) = "eth_getBlockByNumber" - requestMethod (Eth_getTransactionReceiptReq _) = "eth_getTransactionReceipt" - requestMethod (Eth_getCodeReq _ _) = "eth_getCode" - requestIsNotif = const False - -instance ToJSON Req where - toJSON Web3_clientVersionReq = emptyArray - toJSON Eth_blockNumberReq = emptyArray - toJSON (Eth_getBlockByNumberReq blk full) = toJSON (blk, full) - toJSON (Eth_getTransactionReceiptReq txhash) = toJSON [txhash] - 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} - deriving (Show, Eq) - -instance FromResponse Res where - parseResult "web3_clientVersion" = - Just $ withText "clientVersion" (return . Web3_clientVersionRes) - parseResult "eth_blockNumber" = - Just $ withText "blockNumber" (return . Eth_blockNumberRes) - parseResult "eth_getBlockByNumber" = - Just $ withObject "result" (return . Eth_getBlockByNumberRes) - parseResult "eth_getTransactionReceipt" = - Just $ withObject "result" (return . Eth_getTransactionReceiptRes) - parseResult "eth_getCode" = Just $ withText "code" (return . Eth_getCodeRes) - parseResult _ = Nothing - -instance ToJSON Res where - toJSON (Web3_clientVersionRes result) = toJSON result - toJSON (Eth_blockNumberRes result) = toJSON result - toJSON (Eth_getBlockByNumberRes result) = toJSON result - toJSON (Eth_getTransactionReceiptRes result) = toJSON result - toJSON (Eth_getCodeRes codeRes) = toJSON codeRes - -callJsonRpc - :: (MonadIO m, MonadCatch m) - => String -> Int -> Req -> m Res -callJsonRpc server port req = do - initReq <- NHC.parseUrl ("http://" ++ server ++ ":" ++ (show port)) - let requ = - initReq - { NHC.method = "POST" - , NHC.requestHeaders = - ("Content-Type", "application/json") : NHC.requestHeaders initReq - , NHC.requestBody = - RequestBodyLBS $ encode $ toJSON (NJ.buildRequest V2 req (IdInt 1)) - } - manager <- liftIO $ newManager tlsManagerSettings - resp <- NHC.httpLbs requ manager - case decode $ responseBody resp of - 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) - -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 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") <$> - blockInfo <$> - callJsonRpc server port (Eth_getBlockByNumberReq blk False) - -ethGetContractAddrByTxHash - :: (MonadIO m, MonadCatch m) - => String -> Int -> Text -> m (Maybe Text) -ethGetContractAddrByTxHash server port txhash = - (\ares -> - case ares of - (String a) -> - if toLower a == "null" - then Nothing - else Just a - Null -> Nothing - other -> error $ show other) <$> - (lookupDefault (String "error") "contractAddress") <$> - txReceipt <$> - callJsonRpc server port (Eth_getTransactionReceiptReq txhash) - -ethGetCode - :: (MonadIO m, MonadCatch m) - => String -> Int -> Text -> m Text -ethGetCode server port address = - fmap code $ callJsonRpc server port (Eth_getCodeReq address "latest") - -getCode - :: (MonadIO m, MonadCatch m) - => String -> Int -> Text -> m Code -getCode server port address = do - textCode <- ethGetCode server port address - return $ - BDC.Code $ toBytes (hexString (DBC.pack $ T.unpack $ T.drop 3 textCode)) diff --git a/src/Ethereum/Analyzer.hs b/src/Ethereum/Analyzer.hs new file mode 100644 --- /dev/null +++ b/src/Ethereum/Analyzer.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} + +module Ethereum.Analyzer + ( decompile + , decompileHexString + , module Ethereum.Analyzer.Decompile + , module Ethereum.Analyzer.IR + ) where + +import Ethereum.Analyzer.Decompile +import Ethereum.Analyzer.IR diff --git a/src/Ethereum/Analyzer/CfgAugWithTopNPass.hs b/src/Ethereum/Analyzer/CfgAugWithTopNPass.hs new file mode 100644 --- /dev/null +++ b/src/Ethereum/Analyzer/CfgAugWithTopNPass.hs @@ -0,0 +1,370 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts, + FlexibleInstances, GADTs, Rank2Types, DeriveGeneric, TypeFamilies, + UndecidableInstances #-} + +module Ethereum.Analyzer.CfgAugWithTopNPass + ( doCfgAugWithTopNPass + ) where + +import Ethereum.Analyzer +import Ethereum.Analyzer.Common +import Blockchain.ExtWord +import Blockchain.VM.Opcodes as BVO +import Compiler.Hoopl +import Control.Monad +import Data.Bits as Db +import Data.ByteString as DB +import Data.List as DL +import Data.List.Extra +import Data.Maybe as DM +import Data.Set as DS +import Data.Word +import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord + +type StackElemFact = WithTop (Set Word256) + +joinStackElemBase + :: Label + -> OldFact (Set Word256) + -> NewFact (Set Word256) + -> (ChangeFlag, (Set Word256)) +joinStackElemBase _ (OldFact oldF) (NewFact newF) = + if newF `isSubsetOf` oldF + then (NoChange, oldF) + else (SomeChange, oldF `DS.union` newF) + +joinStackElemFact + :: Label + -> OldFact StackElemFact + -> NewFact StackElemFact + -> (ChangeFlag, StackElemFact) +joinStackElemFact = liftJoinTop joinStackElemBase + +type StackNFact = [StackElemFact] + +joinStackNFact :: Label + -> OldFact StackNFact + -> NewFact StackNFact + -> (ChangeFlag, StackNFact) +joinStackNFact l (OldFact oldF) (NewFact newF) = + let zipped = + DL.zipWith (\a b -> joinStackElemFact l (OldFact a) (NewFact b)) oldF newF + (changedL, joinedF) = DL.unzip zipped + in ( changeIf $ + DL.any + (\c -> + case c of + SomeChange -> True + NoChange -> False) + changedL + , joinedF) + +stackNLattice :: Int -> DataflowLattice StackNFact +stackNLattice depth = + DataflowLattice + { fact_name = "stackNLattice" + , fact_bot = DL.replicate depth (PElem DS.empty) + , fact_join = joinStackNFact + } + +_sizeBound :: Int +_sizeBound = 10 + +mkTopList = DL.map (const Top) + +pairCompute :: (Word256 -> Word256 -> Word256) -> StackNFact -> StackNFact +pairCompute fun flist = + if DL.length flist < 2 + then mkTopList flist + else case flist of + Top:_:tl -> (Top : tl) ++ [Top] + _:Top:tl -> (Top : tl) ++ [Top] + PElem st1:PElem st2:tl -> + let l1 = toList st1 + in ((PElem $ DS.unions $ DL.map (\e1 -> DS.map (fun e1) st2) l1) : + tl) ++ + [Top] + +popStack :: Int -> StackNFact -> StackNFact +popStack 0 f = f +popStack n (h:t) = popStack (n - 1) (t ++ [Top]) + +pushStack' :: StackElemFact -> StackNFact -> StackNFact +pushStack' e flist = e : (dropEnd 1 flist) + +pushStack :: Word256 -> StackNFact -> StackNFact +pushStack wd = pushStack' (PElem $ DS.singleton wd) + +pushTop :: StackNFact -> StackNFact +pushTop flist = Top : dropEnd 1 flist + +b2w256 :: Bool -> Word256 +b2w256 True = 1 +b2w256 False = 0 + +w256Not :: Word256 -> Word256 +w256Not wd = bytesToWord256 $ DL.map complement $ word256ToBytes wd + +w256And :: Word256 -> Word256 -> Word256 +w256And wd1 wd2 = + bytesToWord256 $ DL.zipWith (.&.) (word256ToBytes wd1) (word256ToBytes wd2) + +w256Or :: Word256 -> Word256 -> Word256 +w256Or wd1 wd2 = + bytesToWord256 $ DL.zipWith (.|.) (word256ToBytes wd1) (word256ToBytes wd2) + +w256Xor :: Word256 -> Word256 -> Word256 +w256Xor wd1 wd2 = + bytesToWord256 $ DL.zipWith Db.xor (word256ToBytes wd1) (word256ToBytes wd2) + +peekStack :: Int -> StackNFact -> StackElemFact +peekStack _ [] = Top +peekStack 1 (h:t) = h +peekStack n (h:t) = peekStack (n - 1) t + +swapStack :: Int -> StackNFact -> StackNFact +swapStack n stk = + if n + 1 > DL.length stk + then pushTop $ popStack 1 stk + else let (h1:t1, h2:t2) = DL.splitAt n stk + in (h2 : t1) ++ (h1 : t2) + +stackNTransfer :: FwdTransfer HplOp StackNFact +stackNTransfer = mkFTransfer3 coT ooT ocT + where + coT :: HplOp C O -> StackNFact -> StackNFact + coT _ = + DL.map + (\f -> + case f of + Top -> Top + PElem st -> + if DS.size st > _sizeBound + then Top + else PElem st) + ooT :: HplOp O O -> StackNFact -> StackNFact + ooT (OoOp (_, op)) f = opT op f + ooT (HpCodeCopy _) f = f + ocT :: HplOp O C -> StackNFact -> FactBase StackNFact + -- TODO(zchn): Implement JUMPI narrowing + ocT hplop@(OcOp (_, op) _) f = distributeFact hplop (opT op f) + opT :: Operation -> StackNFact -> StackNFact + opT STOP flist = flist + opT ADD flist = pairCompute (+) flist + opT MUL flist = pairCompute (*) flist + opT SUB flist = pairCompute (-) flist + -- TODO(zchn): handle DIVs and MODs + opT DIV flist = popStack 2 flist + opT SDIV flist = popStack 2 flist + opT MOD flist = pairCompute mod flist + opT SMOD flist = popStack 2 flist + -- TODO(zchn): is this right? + opT ADDMOD flist = pairCompute (+) flist + opT MULMOD flist = pairCompute (*) flist + opT EXP flist = popStack 2 flist + opT SIGNEXTEND flist = popStack 2 flist + opT NEG flist = opT SUB $ pushStack 0 flist + opT BVO.LT flist = pairCompute (\a b -> b2w256 $ a < b) flist + opT BVO.GT flist = pairCompute (\a b -> b2w256 $ a > b) flist + -- TODO(zchn): is this right? + opT SLT flist = pairCompute (\a b -> b2w256 $ a < b) flist + opT SGT flist = pairCompute (\a b -> b2w256 $ a > b) flist + opT BVO.EQ flist = pairCompute (\a b -> b2w256 $ a == b) flist + opT ISZERO flist = opT BVO.EQ $ pushStack 0 flist + opT NOT flist = opT BVO.EQ $ pushStack 0 flist + opT AND flist = pairCompute w256And flist + opT OR flist = pairCompute w256Or flist + opT XOR flist = pairCompute w256Xor flist + opT BYTE flist = pushTop $ popStack 2 flist + opT SHA3 flist = pushTop $ popStack 2 flist + opT ADDRESS f = pushTop f + opT BALANCE f = pushTop f + opT ORIGIN f = pushTop f + opT CALLER f = pushTop f + opT CALLVALUE f = pushTop f + opT CALLDATALOAD f = pushTop $ popStack 1 f + opT CALLDATASIZE f = pushTop f + opT CALLDATACOPY f = popStack 3 f + opT CODESIZE f = pushTop f + opT CODECOPY f = popStack 3 f + opT GASPRICE f = pushTop f + opT EXTCODESIZE f = pushTop f + opT EXTCODECOPY f = pushTop $ pushTop $ pushTop $ pushTop f + opT BLOCKHASH f = pushTop f + opT COINBASE f = pushTop f + opT TIMESTAMP f = pushTop f + opT NUMBER f = pushTop f + opT DIFFICULTY f = pushTop f + opT GASLIMIT f = pushTop f + opT POP f = popStack 1 f + opT MLOAD f = pushTop $ popStack 1 f + opT MSTORE f = popStack 2 f + opT MSTORE8 f = popStack 2 f + opT SLOAD f = pushTop $ popStack 1 f + opT SSTORE f = popStack 2 f + opT JUMP f = popStack 1 f + opT JUMPI f = popStack 2 f + opT PC f = pushTop f + opT MSIZE f = pushTop f + opT GAS f = pushTop f + opT JUMPDEST flist = flist + opT (PUSH wl) flist = pushStack (varBytesToWord256 wl) flist + opT DUP1 flist = pushStack' (peekStack 1 flist) flist + opT DUP2 flist = pushStack' (peekStack 2 flist) flist + opT DUP3 flist = pushStack' (peekStack 3 flist) flist + opT DUP4 flist = pushStack' (peekStack 4 flist) flist + opT DUP5 flist = pushStack' (peekStack 5 flist) flist + opT DUP6 flist = pushStack' (peekStack 6 flist) flist + opT DUP7 flist = pushStack' (peekStack 7 flist) flist + opT DUP8 flist = pushStack' (peekStack 8 flist) flist + opT DUP9 flist = pushStack' (peekStack 9 flist) flist + opT DUP10 flist = pushStack' (peekStack 10 flist) flist + opT DUP11 flist = pushStack' (peekStack 11 flist) flist + opT DUP12 flist = pushStack' (peekStack 12 flist) flist + opT DUP13 flist = pushStack' (peekStack 13 flist) flist + opT DUP14 flist = pushStack' (peekStack 14 flist) flist + opT DUP15 flist = pushStack' (peekStack 15 flist) flist + opT DUP16 flist = pushStack' (peekStack 16 flist) flist + opT SWAP1 flist = swapStack 1 flist + opT SWAP2 flist = swapStack 2 flist + opT SWAP3 flist = swapStack 3 flist + opT SWAP4 flist = swapStack 4 flist + opT SWAP5 flist = swapStack 5 flist + opT SWAP6 flist = swapStack 6 flist + opT SWAP7 flist = swapStack 7 flist + opT SWAP8 flist = swapStack 8 flist + opT SWAP9 flist = swapStack 9 flist + opT SWAP10 flist = swapStack 10 flist + opT SWAP11 flist = swapStack 11 flist + opT SWAP12 flist = swapStack 12 flist + opT SWAP13 flist = swapStack 13 flist + opT SWAP14 flist = swapStack 14 flist + opT SWAP15 flist = swapStack 15 flist + opT SWAP16 flist = swapStack 16 flist + opT LOG0 flist = popStack 2 flist + opT LOG1 flist = popStack 3 flist + opT LOG2 flist = popStack 4 flist + opT LOG3 flist = popStack 5 flist + opT LOG4 flist = popStack 6 flist + opT CREATE flist = flist + opT CALL flist = pushTop $ popStack 7 flist + opT CALLCODE flist = pushTop $ popStack 7 flist + opT RETURN flist = popStack 2 flist + opT DELEGATECALL flist = pushTop $ popStack 7 flist + opT SUICIDE flist = popStack 1 flist + -- opT LABEL String flist = flist + -- opT PUSHLABEL String flist = flist + -- opT PUSHDIFF String String flist = flist + -- opT DATA ByteString flist = flist + -- opT MalformedOpcode Word8 flist = flist + opT op@LABEL {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@PUSHLABEL {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@PUSHDIFF {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@DATA {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@MalformedOpcode {} _ = + error $ "Unexpected(stackTopTransfer): " ++ show op + -- TODO(zchn): Implement interp + opT _ flist = DL.map (const Top) flist + +opGUnit :: HplOp e x -> Graph HplOp e x +opGUnit co@CoOp {} = gUnitCO $ BlockCO co BNil +opGUnit oo@OoOp {} = gUnitOO $ BMiddle oo +opGUnit oc@OcOp {} = gUnitOC $ BlockOC BNil oc + +catPElems :: [Pointed e x t] -> [t] +catPElems = mapMaybe maybePElem + where + maybePElem (PElem v) = Just v + maybePElem _ = Nothing + +cfgAugWithTopNRewrite :: FwdRewrite WordLabelMapFuelM HplOp StackNFact +cfgAugWithTopNRewrite = mkFRewrite3 coR ooR ocR + where + coR :: HplOp C O + -> StackNFact + -> WordLabelMapFuelM (Maybe (Graph HplOp C O)) + coR op _ = return $ Just $ opGUnit op + ooR :: HplOp O O + -> StackNFact + -> WordLabelMapFuelM (Maybe (Graph HplOp O O)) + ooR op@(OoOp (_, CODECOPY)) f = + case peekStack 2 f of + Top -> return $ Just $ opGUnit op + PElem vals -> + return $ + Just $ + DS.foldl (\a b -> catGraphNodeOO a $ HpCodeCopy b) (opGUnit op) vals + ooR op _ = return $ Just $ opGUnit op + ocR :: HplOp O C + -> StackNFact + -> WordLabelMapFuelM (Maybe (Graph HplOp O C)) + ocR op@(OcOp (loc, ope) ll) f = + case ope of + JUMP -> handleJmp + JUMPI -> handleJmp + _ -> return $ Just $ opGUnit op + where + handleJmp :: WordLabelMapFuelM (Maybe (Graph HplOp O C)) + handleJmp = + case DL.head f of + Top -> return $ Just $ opGUnit op -- TODO(zchn): Should return all targets + PElem st -> do + newll <- liftFuel $ labelsFor $ toList st + return $ + Just $ + opGUnit $ OcOp (loc, ope) $ toList $ fromList (ll ++ newll) + +_depthBound :: Int +_depthBound = 16 + +cfgAugWithTopNPass :: FwdPass WordLabelMapFuelM HplOp StackNFact +cfgAugWithTopNPass = + FwdPass + { fp_lattice = stackNLattice _depthBound + , fp_transfer = stackNTransfer + , fp_rewrite = cfgAugWithTopNRewrite + } + +doCfgAugWithTopNPass :: ByteString -> WordLabelMapM HplContract +doCfgAugWithTopNPass hexstring = do + let decompiled = decompileHexString hexstring + contract <- evmOps2HplContract decompiled + let entry_ = entryOf $ ctorOf contract + body = bodyOf $ ctorOf contract + case entry_ of + Nothing -> return contract + Just entry -> do + newBody <- + runWithFuel + 10000000000 + (fst <$> + analyzeAndRewriteFwdBody + cfgAugWithTopNPass + entry + body + (mapSingleton entry $ fact_bot $ fp_lattice cfgAugWithTopNPass)) + let blocks = DL.map snd $ bodyList newBody + ooOps = DL.concatMap ((\(_, b, _) -> blockToList b) . blockSplit) blocks + newHexstrings = mapMaybe ( + \op -> case op of + HpCodeCopy offset -> + let newhs = DB.drop (fromInteger (getBigWordInteger offset) * 2) hexstring + in if DB.null newhs then Nothing else Just newhs + _ -> Nothing) ooOps + case newHexstrings of + [] -> return contract { ctorOf = HplCode (Just entry) newBody } + [newhs] -> do + HplCode (Just disEntry) disBody <- + evmOps2HplCode $ decompileHexString newhs + newDisBody <- runWithFuel + 10000000000 + (fst <$> + analyzeAndRewriteFwdBody + cfgAugWithTopNPass + disEntry + disBody + (mapSingleton disEntry $ fact_bot $ fp_lattice cfgAugWithTopNPass)) + return HplContract { ctorOf = HplCode (Just entry) newBody + , dispatcherOf = HplCode (Just disEntry) newDisBody } + _ -> error $ "doCfgAugWithTopNPass: unexpected newHexstrings length: " + ++ (show $ DL.length newHexstrings) diff --git a/src/Ethereum/Analyzer/CfgAugmentPass.hs b/src/Ethereum/Analyzer/CfgAugmentPass.hs new file mode 100644 --- /dev/null +++ b/src/Ethereum/Analyzer/CfgAugmentPass.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts, + FlexibleInstances, GADTs, Rank2Types, DeriveGeneric, TypeFamilies, + UndecidableInstances #-} + +module Ethereum.Analyzer.CfgAugmentPass + ( doCfgAugmentPass + ) where + +import Ethereum.Analyzer +import Ethereum.Analyzer.Common +import Blockchain.ExtWord +import Blockchain.VM.Opcodes +import Compiler.Hoopl +import Data.Bits +import Data.List as DL +import Data.Set as DS + +type StackTopFact = WithTop (Set Word256) + +joinJumpTargets + :: Label + -> OldFact (Set Word256) + -> NewFact (Set Word256) + -> (ChangeFlag, (Set Word256)) +joinJumpTargets _ (OldFact oldF) (NewFact newF) = + if newF `isSubsetOf` oldF + then (NoChange, oldF) + else (SomeChange, oldF `DS.union` newF) + +joinStackTopFact + :: Label + -> OldFact StackTopFact + -> NewFact StackTopFact + -> (ChangeFlag, StackTopFact) +joinStackTopFact = liftJoinTop joinJumpTargets + +stackTopLattice :: DataflowLattice StackTopFact +stackTopLattice = + DataflowLattice + { fact_name = "stackTopLattice" + , fact_bot = PElem DS.empty + , fact_join = joinStackTopFact + } + +stackTopTransfer :: FwdTransfer HplOp StackTopFact +stackTopTransfer = mkFTransfer3 coT ooT ocT + where + coT :: HplOp C O -> StackTopFact -> StackTopFact + coT _ f = f + ooT :: HplOp O O -> StackTopFact -> StackTopFact + ooT (OoOp (_, op)) f = opT op f + ocT :: HplOp O C -> StackTopFact -> FactBase StackTopFact + ocT hplop@(OcOp (_, op) _) f = distributeFact hplop (opT op f) + opT :: Operation -> StackTopFact -> StackTopFact + opT DUP1 f = f + opT ISZERO (PElem st) = + PElem $ + DS.map + (\wd -> + if wd == 0 + then 1 + else 0) + st + opT JUMPDEST f = f + opT NEG (PElem st) = PElem $ DS.map (\wd -> -wd) st + opT NOT (PElem st) = + PElem $ + DS.map (\wd -> bytesToWord256 $ DL.map complement $ word256ToBytes wd) st + opT (PUSH w8l) _ = PElem $ DS.singleton $ varBytesToWord256 w8l + opT op@LABEL {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@PUSHLABEL {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@PUSHDIFF {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@DATA {} _ = error $ "Unexpected(stackTopTransfer): " ++ show op + opT op@MalformedOpcode {} _ = + error $ "Unexpected(stackTopTransfer): " ++ show op + opT _ _ = Top + +opGUnit :: HplOp e x -> Graph HplOp e x +opGUnit co@CoOp {} = gUnitCO $ BlockCO co BNil +opGUnit oo@OoOp {} = gUnitOO $ BMiddle oo +opGUnit oc@OcOp {} = gUnitOC $ BlockOC BNil oc + +cfgAugmentRewrite :: FwdRewrite WordLabelMapFuelM HplOp StackTopFact +cfgAugmentRewrite = mkFRewrite3 coR ooR ocR + where + coR :: HplOp C O + -> StackTopFact + -> WordLabelMapFuelM (Maybe (Graph HplOp C O)) + coR op _ = return $ Just $ opGUnit op + ooR :: HplOp O O + -> StackTopFact + -> WordLabelMapFuelM (Maybe (Graph HplOp O O)) + ooR op _ = return $ Just $ opGUnit op + ocR :: HplOp O C + -> StackTopFact + -> WordLabelMapFuelM (Maybe (Graph HplOp O C)) + ocR op@(OcOp (loc, ope) ll) f = + case ope of + JUMP -> handleJmp + JUMPI -> handleJmp + _ -> return $ Just $ opGUnit op + where + handleJmp :: WordLabelMapFuelM (Maybe (Graph HplOp O C)) + handleJmp = + case f of + Top -> return $ Just $ opGUnit op -- TODO(zchn): Should return all targets + PElem st -> do + newll <- liftFuel $ labelsFor $ toList st + return $ + Just $ + opGUnit $ OcOp (loc, ope) $ toList $ fromList (ll ++ newll) + +cfgAugmentPass :: FwdPass WordLabelMapFuelM HplOp StackTopFact +cfgAugmentPass = + FwdPass + { fp_lattice = stackTopLattice + , fp_transfer = stackTopTransfer + , fp_rewrite = cfgAugmentRewrite + } + +doCfgAugmentPass :: HplContract -> WordLabelMapM HplContract +doCfgAugmentPass contract = + let entry_ = entryOf $ ctorOf contract + body = bodyOf $ ctorOf contract + in case entry_ of + Nothing -> return contract + Just entry -> do + newBody <- + runWithFuel + 1000000 + (fst <$> + analyzeAndRewriteFwdBody + cfgAugmentPass + entry + body + (mapSingleton entry Top)) + return + contract + { ctorOf = HplCode (Just entry) newBody + } diff --git a/src/Ethereum/Analyzer/Common.hs b/src/Ethereum/Analyzer/Common.hs new file mode 100644 --- /dev/null +++ b/src/Ethereum/Analyzer/Common.hs @@ -0,0 +1,15 @@ +module Ethereum.Analyzer.Common + ( varBytesToWord256 + ) where + +import Data.ByteString as DB +import Data.Word +import Blockchain.ExtWord + +zero256 :: ByteString +zero256 = DB.replicate 32 0 + +varBytesToWord256 :: [Word8] -> Word256 +varBytesToWord256 w8l = + let extended = (zero256 `append` DB.pack w8l) + in bytesToWord256 $ DB.unpack $ DB.drop (DB.length extended - 32) extended diff --git a/src/Ethereum/Analyzer/Decompile.hs b/src/Ethereum/Analyzer/Decompile.hs new file mode 100644 --- /dev/null +++ b/src/Ethereum/Analyzer/Decompile.hs @@ -0,0 +1,32 @@ +module Ethereum.Analyzer.Decompile + ( decompile + , decompileHexString + ) where + +import Blockchain.Data.Code +import Blockchain.ExtWord +import Blockchain.Util +import Blockchain.VM.Code +import Blockchain.VM.Opcodes +import Data.ByteString +import Data.HexString + +decompileHexString :: ByteString -> [(Word256, Operation)] +decompileHexString = decompileBS . toBytes . hexString + +decompile :: Code -> [(Word256, Operation)] +decompile (Code bs) = decompileBS bs +decompile _ = [] + +decompileBS :: ByteString -> [(Word256, Operation)] +decompileBS bs = + let hardlimit = 10000 + in decompileBSAt bs 0 hardlimit + +decompileBSAt :: ByteString -> Word256 -> Int -> [(Word256, Operation)] +decompileBSAt "" _ _ = [] +decompileBSAt _ _ 0 = [] +decompileBSAt bs base limit = + (base, op) : decompileBSAt (safeDrop next bs) (base + next) (limit - 1) + where + (op, next) = getOperationAt' bs 0 diff --git a/src/Ethereum/Analyzer/IR.hs b/src/Ethereum/Analyzer/IR.hs new file mode 100644 --- /dev/null +++ b/src/Ethereum/Analyzer/IR.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts, + FlexibleInstances, GADTs, Rank2Types, DeriveGeneric, TypeFamilies, + UndecidableInstances #-} + +module Ethereum.Analyzer.IR + ( HplBody + , HplCode(..) + , HplContract(..) + , HplOp(..) + , WordLabelMapM + , WordLabelMapFuelM + , unWordLabelMapM + , evmOps2HplCode + , evmOps2HplContract + , labelFor + , labelsFor + , showOp + , showOps + ) where + +import Blockchain.ExtWord as BE +import Blockchain.VM.Opcodes as BVO +import Compiler.Hoopl as CH +import Control.Monad as CM +import Data.Bimap as DB + +-- import Data.Graph.Inductive.Graph as DGIG +import Data.Text as DT +import qualified Data.Text.Lazy as DTL +import Data.List as DL +import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord + +data HplOp e x where + CoOp :: Label -> HplOp C O + OoOp :: (Word256, Operation) -> HplOp O O + OcOp :: (Word256, Operation) -> [Label] -> HplOp O C + HpCodeCopy :: Word256 -> HplOp O O + +showLoc :: Word256 -> String +showLoc = show . getBigWordInteger + +showOp :: (Word256, Operation) -> String +showOp (lineNo, op) = showLoc lineNo ++ ": " ++ show op + +showOps :: [(Word256, Operation)] -> [String] +showOps = Prelude.map showOp + +instance Show (HplOp e x) where + show (CoOp l) = "CO: " ++ show l + show (OoOp op) = "OO: " ++ showOp op + show (OcOp op ll) = "OC: " ++ showOp op ++ " -> " ++ show ll + show (HpCodeCopy offset) = "HpCodeCopy " ++ show offset + +instance Show (Block HplOp C C) where + show a = + let (h, m, t) = blockSplit a + in DL.unlines $ [show h] ++ DL.map show (blockToList m) ++ [show t] + +instance Eq (HplOp C O) where + (==) (CoOp a) (CoOp b) = a == b + +instance Eq (HplOp O O) where + (==) (OoOp a) (OoOp b) = a == b + (==) (HpCodeCopy a) (HpCodeCopy b) = a == b + (==) _ _ = False + +instance Eq (HplOp O C) where + (==) (OcOp a _) (OcOp b _) = a == b + +instance NonLocal HplOp where + entryLabel (CoOp l) = l + successors (OcOp _ ll) = ll + +type HplBody = Body HplOp + +data HplCode = HplCode + { entryOf :: Maybe Label + , bodyOf :: HplBody + } deriving (Show) + +data HplContract = HplContract + { ctorOf :: HplCode + , dispatcherOf :: HplCode + } deriving (Show) + +emptyCode :: HplCode +emptyCode = HplCode Nothing emptyBody + +evmOps2HplContract :: [(Word256, Operation)] -> WordLabelMapM HplContract +evmOps2HplContract l = do + ctorBody <- evmOps2HplCode l + return + HplContract + { ctorOf = ctorBody + , dispatcherOf = emptyCode + } + +evmOps2HplCode :: [(Word256, Operation)] -> WordLabelMapM HplCode +evmOps2HplCode [] = return emptyCode +evmOps2HplCode l@((loc, _):_) = do + entry <- labelFor loc + body <- _evmOps2HplBody l + return + HplCode + { entryOf = Just entry + , bodyOf = body + } + +_evmOps2HplBody :: [(Word256, Operation)] -> WordLabelMapM HplBody +_evmOps2HplBody [] = return emptyBody +_evmOps2HplBody el@((loc, _):_) = do + l <- labelFor loc + doEvmOps2HplBody emptyBody (blockJoinHead (CoOp l) emptyBlock) el + where + doEvmOps2HplBody :: HplBody + -> (Block HplOp C O) + -> [(Word256, Operation)] + -> WordLabelMapM HplBody + doEvmOps2HplBody body _ [] = return body -- sliently discarding bad hds + doEvmOps2HplBody body hd [h'] = + if isTerminator (snd h') + then return $ addBlock (blockJoinTail hd (OcOp h' [])) body + else return body + doEvmOps2HplBody body hd (h':(t'@((loc', op'):_))) + | isTerminator (snd h') = do + l' <- labelFor loc' + doEvmOps2HplBody + (addBlock + (blockJoinTail + hd + (OcOp + h' + (if canPassThrough (snd h') + then [l'] + else []))) + body) + (blockJoinHead (CoOp l') emptyBlock) + t' + | op' /= JUMPDEST = doEvmOps2HplBody body (blockSnoc hd (OoOp h')) t' + | otherwise = do + l' <- labelFor loc' + doEvmOps2HplBody + (addBlock + (blockJoinTail + hd + (OcOp + h' + (if canPassThrough (snd h') + then [l'] + else []))) + body) + (blockJoinHead (CoOp l') emptyBlock) + t' + +isTerminator :: Operation -> Bool +isTerminator STOP = True +isTerminator JUMP = True +isTerminator JUMPI = True +isTerminator CALL = True +isTerminator CALLCODE = True +isTerminator RETURN = True +isTerminator DELEGATECALL = True +isTerminator INVALID = True +isTerminator SUICIDE = True +isTerminator _ = False + +canPassThrough :: Operation -> Bool +canPassThrough STOP = False +canPassThrough JUMP = False +canPassThrough RETURN = False +canPassThrough INVALID = False +canPassThrough SUICIDE = False +canPassThrough _ = True + +-------------------------------------------------------------------------------- +-- The WordLabelMapM monad +-------------------------------------------------------------------------------- +type WordLabelMap = Bimap Word256 Label + +data WordLabelMapM a = + WordLabelMapM (WordLabelMap -> SimpleUniqueMonad (WordLabelMap, a)) + +instance CheckpointMonad WordLabelMapM where + type Checkpoint WordLabelMapM = (WordLabelMap, Checkpoint SimpleUniqueMonad) + checkpoint = + let mapper + :: WordLabelMap + -> SimpleUniqueMonad (WordLabelMap, Checkpoint WordLabelMapM) + mapper m = do + suCheckpoint <- CH.checkpoint + return (m, (m, suCheckpoint)) + in WordLabelMapM mapper + restart (m, suCheckpoint) = + let mapper :: WordLabelMap -> CH.SimpleUniqueMonad (WordLabelMap, ()) + mapper _ = do + _ <- CH.restart suCheckpoint + return (m, ()) + in WordLabelMapM mapper + +type WordLabelMapFuelM = CheckingFuelMonad WordLabelMapM + +labelFor :: Word256 -> WordLabelMapM Label +labelFor word = WordLabelMapM f + where + f m = + case DB.lookup word m of + Just l' -> return (m, l') + Nothing -> do + l' <- freshLabel + let m' = DB.insert word l' m + return (m', l') + +labelsFor :: [Word256] -> WordLabelMapM [Label] +labelsFor = mapM labelFor + +instance Monad WordLabelMapM where + return = pure + WordLabelMapM f1 >>= k = + WordLabelMapM $ + \m -> do + (m', x) <- f1 m + let (WordLabelMapM f2) = k x + f2 m' + +instance Functor WordLabelMapM where + fmap = liftM + +instance Applicative WordLabelMapM where + pure x = WordLabelMapM (\m -> return (m, x)) + (<*>) = ap + +class UnWordLabelMapM a where + unWordLabelMapM :: WordLabelMapM a -> a + +instance UnWordLabelMapM Int where + unWordLabelMapM = internalUnWordLabelMapM + +instance UnWordLabelMapM String where + unWordLabelMapM = internalUnWordLabelMapM + +instance UnWordLabelMapM Text where + unWordLabelMapM = internalUnWordLabelMapM + +instance UnWordLabelMapM DTL.Text where + unWordLabelMapM = internalUnWordLabelMapM + +instance (UnWordLabelMapM a, UnWordLabelMapM b) => + UnWordLabelMapM (a, b) where + unWordLabelMapM = internalUnWordLabelMapM + +internalUnWordLabelMapM :: WordLabelMapM a -> a +internalUnWordLabelMapM (WordLabelMapM f) = + snd $ runSimpleUniqueMonad (f DB.empty) diff --git a/src/Ethereum/Analyzer/Util.hs b/src/Ethereum/Analyzer/Util.hs new file mode 100644 --- /dev/null +++ b/src/Ethereum/Analyzer/Util.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts, + OverloadedStrings, FlexibleInstances, GADTs, Rank2Types, + DeriveGeneric, TypeFamilies, UndecidableInstances #-} + +module Ethereum.Analyzer.Util + ( toDotText + , decompileToDotText + , decompileToDotText2 + ) where + +import Ethereum.Analyzer.Decompile +import Ethereum.Analyzer.IR +import Ethereum.Analyzer.CfgAugWithTopNPass +import Ethereum.Analyzer.CfgAugmentPass +import Compiler.Hoopl +import Data.ByteString.Char8 as DBC +import Data.GraphViz +import Data.GraphViz.Printing +import Data.Graph.Inductive.Graph as DGIG +import Data.Graph.Inductive.PatriciaTree +import Data.Text as DT +import qualified Data.Text.Lazy as DTL + +decompileToDotText :: Text -> Text +decompileToDotText hexcode = + let decompiled = decompileHexString $ DBC.pack $ DT.unpack hexcode + result = + unWordLabelMapM $ + do contract <- evmOps2HplContract decompiled + toDotText <$> (bodyOf . ctorOf <$> doCfgAugmentPass contract) + in result + +decompileToDotText2 :: Text -> (Text, Text) +decompileToDotText2 hexcode = + let hexstring = DBC.pack $ DT.unpack hexcode + result = + unWordLabelMapM $ + do contract' <- doCfgAugWithTopNPass hexstring + return + ( toDotText $ bodyOf (ctorOf contract') + , toDotText $ bodyOf (dispatcherOf contract')) + in result + +toDotText :: HplBody -> Text +toDotText bd = + let bdGr = toGr bd + dotG = toDotGraph bdGr + dotCode = toDot dotG + in DTL.toStrict $ renderDot dotCode + +toGr :: HplBody -> Gr (Block HplOp C C) () +toGr bd = + let lblToNode l = read (Prelude.drop 1 $ show l) + (nList, eList) = + mapFoldWithKey + (\lbl blk (nList', eList') -> + let node = lblToNode lbl + edgs = + Prelude.map (\l -> (node, lblToNode l, ())) (successors blk) + in (nList' ++ [(node, blk)], eList' ++ edgs)) + ([], []) + bd + in mkGraph nList eList + +visParams = + nonClusteredParams + { fmtNode = \(_, nl) -> [toLabel $ show nl, shape BoxShape] + } + +toDotGraph :: Gr (Block HplOp C C) () -> DotGraph Node +toDotGraph gr = graphToDot visParams gr diff --git a/test/Blockchain/Analyze/CfgAugWithTopNPassSpec.hs b/test/Blockchain/Analyze/CfgAugWithTopNPassSpec.hs deleted file mode 100644 --- a/test/Blockchain/Analyze/CfgAugWithTopNPassSpec.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} - -module Blockchain.Analyze.CfgAugWithTopNPassSpec - ( spec - ) where - -import Blockchain.Analyze -import Blockchain.Analyze.CfgAugWithTopNPass -import SpecCommon -import Test.Hspec - -spec :: Spec -spec = do - describe "doCfgAugWithTopNPass" $ - do it "works for hexcode1" $ - do let result = - unWordLabelMapM $ - show <$> doCfgAugWithTopNPass hexcode1 - length result `shouldBe` 4815 - it "works for hexcode2" $ - do let result = - unWordLabelMapM $ - show <$> doCfgAugWithTopNPass hexcode2 - result `shouldContain` "OC: 9: JUMPI -> [L2,L4]" diff --git a/test/Blockchain/Analyze/CfgAugmentPassSpec.hs b/test/Blockchain/Analyze/CfgAugmentPassSpec.hs deleted file mode 100644 --- a/test/Blockchain/Analyze/CfgAugmentPassSpec.hs +++ /dev/null @@ -1,172 +0,0 @@ -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} - -module Blockchain.Analyze.CfgAugmentPassSpec - ( spec - ) where - -import Blockchain.Analyze -import Blockchain.Analyze.CfgAugmentPass -import SpecCommon -import Test.Hspec - -spec :: Spec -spec = do - describe "doCfgAugmentPass" $ - do it "works for hexcode1" $ - do let decompiled = decompileHexString hexcode1 - result = - unWordLabelMapM $ - do contract <- evmOps2HplContract decompiled - show <$> doCfgAugmentPass contract - length result `shouldBe` 4769 - it "works for hexcode2" $ - do let decompiled@((loc, _):_) = decompileHexString hexcode2 - result = - unWordLabelMapM $ - do contract <- evmOps2HplContract decompiled - show . bodyOf . ctorOf <$> doCfgAugmentPass contract - result `shouldBe` "LM (UM (fromList [(1,CO: L1\n" ++ - "OO: 0: PUSH [96]\n" ++ - "OO: 2: PUSH [64]\n" ++ - "OO: 4: MSTORE\n" ++ - "OO: 5: CALLDATASIZE\n" ++ - "OO: 6: ISZERO\n" ++ - "OO: 7: PUSH [39]\n" ++ - "OC: 9: JUMPI -> [L2,L4]\n" ++ - "),(2,CO: L2\n" ++ - "OO: 10: PUSH [224]\n" ++ - "OO: 12: PUSH [2]\n" ++ - "OO: 14: EXP\n" ++ - "OO: 15: PUSH [0]\n" ++ - "OO: 17: CALLDATALOAD\n" ++ - "OO: 18: DIV\n" ++ - "OO: 19: PUSH [65,192,225,181]\n" ++ - "OO: 24: DUP2\n" ++ - "OO: 25: EQ\n" ++ - "OO: 26: PUSH [110]\n" ++ - "OC: 28: JUMPI -> [L3,L7]\n" ++ - "),(3,CO: L3\n" ++ - "OO: 29: DUP1\n" ++ - "OO: 30: PUSH [229,34,83,129]\n" ++ - "OO: 35: EQ\n" ++ - "OO: 36: PUSH [150]\n" ++ - "OC: 38: JUMPI -> [L4,L9]\n" ++ - "),(4,CO: L4\n" ++ - "OO: 39: JUMPDEST\n" ++ - "OO: 40: PUSH [213]\n" ++ - "OO: 42: PUSH [0]\n" ++ - "OO: 44: CALLVALUE\n" ++ - "OO: 45: GT\n" ++ - "OO: 46: ISZERO\n" ++ - "OO: 47: PUSH [108]\n" ++ - "OC: 49: JUMPI -> [L5,L6]\n" ++ - "),(5,CO: L5\n" ++ - "OO: 50: CALLVALUE\n" ++ - "OO: 51: PUSH [96]\n" ++ - "OO: 53: SWAP1\n" ++ - "OO: 54: DUP2\n" ++ - "OO: 55: MSTORE\n" ++ - "OO: 56: PUSH [88]\n" ++ - "OO: 58: SWAP1\n" ++ - "OO: 59: PUSH [1]\n" ++ - "OO: 61: PUSH [160]\n" ++ - "OO: 63: PUSH [2]\n" ++ - "OO: 65: EXP\n" ++ - "OO: 66: SUB\n" ++ - "OO: 67: CALLER\n" ++ - "OO: 68: AND\n" ++ - "OO: 69: SWAP1\n" ++ - "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\n" ++ - "OO: 103: SWAP1\n" ++ - "OO: 104: PUSH [32]\n" ++ - "OO: 106: SWAP1\n" ++ - "OC: 107: LOG3 -> [L6]\n" ++ - "),(6,CO: L6\n" ++ - "OO: 108: JUMPDEST\n" ++ - "OC: 109: JUMP -> []\n" ++ - "),(7,CO: L7\n" ++ - "OO: 110: JUMPDEST\n" ++ - "OO: 111: PUSH [213]\n" ++ - "OO: 113: PUSH [0]\n" ++ - "OO: 115: SLOAD\n" ++ - "OO: 116: PUSH [1]\n" ++ - "OO: 118: PUSH [160]\n" ++ - "OO: 120: PUSH [2]\n" ++ - "OO: 122: EXP\n" ++ - "OO: 123: SUB\n" ++ - "OO: 124: SWAP1\n" ++ - "OO: 125: DUP2\n" ++ - "OO: 126: AND\n" ++ - "OO: 127: CALLER\n" ++ - "OO: 128: SWAP2\n" ++ - "OO: 129: SWAP1\n" ++ - "OO: 130: SWAP2\n" ++ - "OO: 131: AND\n" ++ - "OO: 132: EQ\n" ++ - "OO: 133: ISZERO\n" ++ - "OO: 134: PUSH [108]\n" ++ - "OC: 136: JUMPI -> [L6,L8]\n" ++ - "),(8,CO: L8\n" ++ - "OO: 137: PUSH [0]\n" ++ - "OO: 139: SLOAD\n" ++ - "OO: 140: PUSH [1]\n" ++ - "OO: 142: PUSH [160]\n" ++ - "OO: 144: PUSH [2]\n" ++ - "OO: 146: EXP\n" ++ - "OO: 147: SUB\n" ++ - "OO: 148: AND\n" ++ - "OC: 149: SUICIDE -> []\n" ++ - "),(9,CO: L9\n" ++ - "OO: 150: JUMPDEST\n" ++ - "OO: 151: PUSH [213]\n" ++ - "OO: 153: PUSH [0]\n" ++ - "OO: 155: SLOAD\n" ++ - "OO: 156: PUSH [1]\n" ++ - "OO: 158: PUSH [160]\n" ++ - "OO: 160: PUSH [2]\n" ++ - "OO: 162: EXP\n" ++ - "OO: 163: SUB\n" ++ - "OO: 164: SWAP1\n" ++ - "OO: 165: DUP2\n" ++ - "OO: 166: AND\n" ++ - "OO: 167: CALLER\n" ++ - "OO: 168: SWAP2\n" ++ - "OO: 169: SWAP1\n" ++ - "OO: 170: SWAP2\n" ++ - "OO: 171: AND\n" ++ - "OO: 172: EQ\n" ++ - "OO: 173: ISZERO\n" ++ - "OO: 174: PUSH [108]\n" ++ - "OC: 176: JUMPI -> [L6,L10]\n" ++ - "),(10,CO: L10\n" ++ - "OO: 177: PUSH [0]\n" ++ - "OO: 179: DUP1\n" ++ - "OO: 180: SLOAD\n" ++ - "OO: 181: PUSH [1]\n" ++ - "OO: 183: PUSH [160]\n" ++ - "OO: 185: PUSH [2]\n" ++ - "OO: 187: EXP\n" ++ - "OO: 188: SUB\n" ++ - "OO: 189: SWAP1\n" ++ - "OO: 190: DUP2\n" ++ - "OO: 191: AND\n" ++ - "OO: 192: SWAP2\n" ++ - "OO: 193: SWAP1\n" ++ - "OO: 194: ADDRESS\n" ++ - "OO: 195: AND\n" ++ - "OO: 196: BALANCE\n" ++ - "OO: 197: PUSH [96]\n" ++ - "OO: 199: DUP3\n" ++ - "OO: 200: DUP2\n" ++ - "OO: 201: DUP2\n" ++ - "OO: 202: DUP2\n" ++ - "OO: 203: DUP6\n" ++ - "OO: 204: DUP9\n" ++ - "OO: 205: DUP4\n" ++ - "OC: 206: CALL -> [L11]\n" ++ - "),(11,CO: L11\n" ++ - "OO: 207: POP\n" ++ - "OO: 208: POP\n" ++ - "OO: 209: POP\n" ++ - "OO: 210: POP\n" ++ - "OO: 211: POP\n" ++ "OC: 212: JUMP -> []\n" ++ ")]))" diff --git a/test/Blockchain/Analyze/IRSpec.hs b/test/Blockchain/Analyze/IRSpec.hs deleted file mode 100644 --- a/test/Blockchain/Analyze/IRSpec.hs +++ /dev/null @@ -1,177 +0,0 @@ -module Blockchain.Analyze.IRSpec - ( spec - ) where - -import Blockchain.Analyze -import Compiler.Hoopl -import SpecCommon -import Test.Hspec - -spec :: Spec -spec = do - describe "e2h" $ - do it "works for hexcode1" $ - do let decompiled = decompileHexString hexcode1 - unWordLabelMapM - (mapSize . bodyOf . ctorOf <$> (evmOps2HplContract decompiled)) `shouldBe` - 327 - it "works for hexcode2" $ - do let decompiled = decompileHexString hexcode2 - unWordLabelMapM - (mapSize . bodyOf . ctorOf <$> (evmOps2HplContract decompiled)) `shouldBe` - 12 - -- it "shows voteHexcode" $ - -- do let decompiled = decompileHexString voteHexcode - -- unWordLabelMapM (show <$> (evmOps2HplBody decompiled)) `shouldBe` "" - it "shows HplBody" $ - do let decompiled = decompileHexString hexcode2 - unWordLabelMapM - (show . bodyOf . ctorOf <$> (evmOps2HplContract decompiled)) `shouldBe` - "LM (UM (fromList [(1,CO: L1\n" ++ - "OO: 0: PUSH [96]\n" ++ - "OO: 2: PUSH [64]\n" ++ - "OO: 4: MSTORE\n" ++ - "OO: 5: CALLDATASIZE\n" ++ - "OO: 6: ISZERO\n" ++ - "OO: 7: PUSH [39]\n" ++ - "OC: 9: JUMPI -> [L2]\n" ++ - "),(2,CO: L2\n" ++ - "OO: 10: PUSH [224]\n" ++ - "OO: 12: PUSH [2]\n" ++ - "OO: 14: EXP\n" ++ - "OO: 15: PUSH [0]\n" ++ - "OO: 17: CALLDATALOAD\n" ++ - "OO: 18: DIV\n" ++ - "OO: 19: PUSH [65,192,225,181]\n" ++ - "OO: 24: DUP2\n" ++ - "OO: 25: EQ\n" ++ - "OO: 26: PUSH [110]\n" ++ - "OC: 28: JUMPI -> [L3]\n" ++ - "),(3,CO: L3\n" ++ - "OO: 29: DUP1\n" ++ - "OO: 30: PUSH [229,34,83,129]\n" ++ - "OO: 35: EQ\n" ++ - "OO: 36: PUSH [150]\n" ++ - "OC: 38: JUMPI -> [L4]\n" ++ - "),(4,CO: L4\n" ++ - "OO: 39: JUMPDEST\n" ++ - "OO: 40: PUSH [213]\n" ++ - "OO: 42: PUSH [0]\n" ++ - "OO: 44: CALLVALUE\n" ++ - "OO: 45: GT\n" ++ - "OO: 46: ISZERO\n" ++ - "OO: 47: PUSH [108]\n" ++ - "OC: 49: JUMPI -> [L5]\n" ++ - "),(5,CO: L5\n" ++ - "OO: 50: CALLVALUE\n" ++ - "OO: 51: PUSH [96]\n" ++ - "OO: 53: SWAP1\n" ++ - "OO: 54: DUP2\n" ++ - "OO: 55: MSTORE\n" ++ - "OO: 56: PUSH [88]\n" ++ - "OO: 58: SWAP1\n" ++ - "OO: 59: PUSH [1]\n" ++ - "OO: 61: PUSH [160]\n" ++ - "OO: 63: PUSH [2]\n" ++ - "OO: 65: EXP\n" ++ - "OO: 66: SUB\n" ++ - "OO: 67: CALLER\n" ++ - "OO: 68: AND\n" ++ - "OO: 69: SWAP1\n" ++ - "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\n" ++ - "OO: 103: SWAP1\n" ++ - "OO: 104: PUSH [32]\n" ++ - "OO: 106: SWAP1\n" ++ - "OC: 107: LOG3 -> [L6]\n" ++ - "),(6,CO: L6\n" ++ - "OO: 108: JUMPDEST\n" ++ - "OC: 109: JUMP -> []\n" ++ - "),(7,CO: L7\n" ++ - "OO: 110: JUMPDEST\n" ++ - "OO: 111: PUSH [213]\n" ++ - "OO: 113: PUSH [0]\n" ++ - "OO: 115: SLOAD\n" ++ - "OO: 116: PUSH [1]\n" ++ - "OO: 118: PUSH [160]\n" ++ - "OO: 120: PUSH [2]\n" ++ - "OO: 122: EXP\n" ++ - "OO: 123: SUB\n" ++ - "OO: 124: SWAP1\n" ++ - "OO: 125: DUP2\n" ++ - "OO: 126: AND\n" ++ - "OO: 127: CALLER\n" ++ - "OO: 128: SWAP2\n" ++ - "OO: 129: SWAP1\n" ++ - "OO: 130: SWAP2\n" ++ - "OO: 131: AND\n" ++ - "OO: 132: EQ\n" ++ - "OO: 133: ISZERO\n" ++ - "OO: 134: PUSH [108]\n" ++ - "OC: 136: JUMPI -> [L8]\n" ++ - "),(8,CO: L8\n" ++ - "OO: 137: PUSH [0]\n" ++ - "OO: 139: SLOAD\n" ++ - "OO: 140: PUSH [1]\n" ++ - "OO: 142: PUSH [160]\n" ++ - "OO: 144: PUSH [2]\n" ++ - "OO: 146: EXP\n" ++ - "OO: 147: SUB\n" ++ - "OO: 148: AND\n" ++ - "OC: 149: SUICIDE -> []\n" ++ - "),(9,CO: L9\n" ++ - "OO: 150: JUMPDEST\n" ++ - "OO: 151: PUSH [213]\n" ++ - "OO: 153: PUSH [0]\n" ++ - "OO: 155: SLOAD\n" ++ - "OO: 156: PUSH [1]\n" ++ - "OO: 158: PUSH [160]\n" ++ - "OO: 160: PUSH [2]\n" ++ - "OO: 162: EXP\n" ++ - "OO: 163: SUB\n" ++ - "OO: 164: SWAP1\n" ++ - "OO: 165: DUP2\n" ++ - "OO: 166: AND\n" ++ - "OO: 167: CALLER\n" ++ - "OO: 168: SWAP2\n" ++ - "OO: 169: SWAP1\n" ++ - "OO: 170: SWAP2\n" ++ - "OO: 171: AND\n" ++ - "OO: 172: EQ\n" ++ - "OO: 173: ISZERO\n" ++ - "OO: 174: PUSH [108]\n" ++ - "OC: 176: JUMPI -> [L10]\n" ++ - "),(10,CO: L10\n" ++ - "OO: 177: PUSH [0]\n" ++ - "OO: 179: DUP1\n" ++ - "OO: 180: SLOAD\n" ++ - "OO: 181: PUSH [1]\n" ++ - "OO: 183: PUSH [160]\n" ++ - "OO: 185: PUSH [2]\n" ++ - "OO: 187: EXP\n" ++ - "OO: 188: SUB\n" ++ - "OO: 189: SWAP1\n" ++ - "OO: 190: DUP2\n" ++ - "OO: 191: AND\n" ++ - "OO: 192: SWAP2\n" ++ - "OO: 193: SWAP1\n" ++ - "OO: 194: ADDRESS\n" ++ - "OO: 195: AND\n" ++ - "OO: 196: BALANCE\n" ++ - "OO: 197: PUSH [96]\n" ++ - "OO: 199: DUP3\n" ++ - "OO: 200: DUP2\n" ++ - "OO: 201: DUP2\n" ++ - "OO: 202: DUP2\n" ++ - "OO: 203: DUP6\n" ++ - "OO: 204: DUP9\n" ++ - "OO: 205: DUP4\n" ++ - "OC: 206: CALL -> [L11]\n" ++ - "),(11,CO: L11\n" ++ - "OO: 207: POP\n" ++ - "OO: 208: POP\n" ++ - "OO: 209: POP\n" ++ - "OO: 210: POP\n" ++ - "OO: 211: POP\n" ++ - "OC: 212: JUMP -> []\n" ++ - "),(12,CO: L12\n" ++ - "OO: 213: JUMPDEST\n" ++ "OC: 214: STOP -> []\n" ++ ")]))" diff --git a/test/Blockchain/Analyze/UtilSpec.hs b/test/Blockchain/Analyze/UtilSpec.hs deleted file mode 100644 --- a/test/Blockchain/Analyze/UtilSpec.hs +++ /dev/null @@ -1,386 +0,0 @@ -module Blockchain.Analyze.UtilSpec - ( spec - ) where - -import Blockchain.Analyze -import Blockchain.Analyze.CfgAugmentPass -import Blockchain.Analyze.Util -import Data.Text -import SpecCommon -import Test.Hspec - -spec :: Spec -spec = do - describe "toDotText" $ - do it "shows HplBody's dot graph" $ - do let decompiled = decompileHexString hexcode2 - unWordLabelMapM - (unpack . toDotText . bodyOf . ctorOf <$> - (evmOps2HplContract decompiled)) `shouldBe` - "digraph {\n" ++ - " 1 [label=\"CO: L1\\n" ++ - "OO: 0: PUSH [96]\\n" ++ - "OO: 2: PUSH [64]\\n" ++ - "OO: 4: MSTORE\\n" ++ - "OO: 5: CALLDATASIZE\\n" ++ - "OO: 6: ISZERO\\n" ++ - "OO: 7: PUSH [39]\\n" ++ - "OC: 9: JUMPI -> [L2]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 2 [label=\"CO: L2\\n" ++ - "OO: 10: PUSH [224]\\n" ++ - "OO: 12: PUSH [2]\\n" ++ - "OO: 14: EXP\\n" ++ - "OO: 15: PUSH [0]\\n" ++ - "OO: 17: CALLDATALOAD\\n" ++ - "OO: 18: DIV\\n" ++ - "OO: 19: PUSH [65,192,225,181]\\n" ++ - "OO: 24: DUP2\\n" ++ - "OO: 25: EQ\\n" ++ - "OO: 26: PUSH [110]\\n" ++ - "OC: 28: JUMPI -> [L3]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 3 [label=\"CO: L3\\n" ++ - "OO: 29: DUP1\\n" ++ - "OO: 30: PUSH [229,34,83,129]\\n" ++ - "OO: 35: EQ\\n" ++ - "OO: 36: PUSH [150]\\n" ++ - "OC: 38: JUMPI -> [L4]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 4 [label=\"CO: L4\\n" ++ - "OO: 39: JUMPDEST\\n" ++ - "OO: 40: PUSH [213]\\n" ++ - "OO: 42: PUSH [0]\\n" ++ - "OO: 44: CALLVALUE\\n" ++ - "OO: 45: GT\\n" ++ - "OO: 46: ISZERO\\n" ++ - "OO: 47: PUSH [108]\\n" ++ - "OC: 49: JUMPI -> [L5]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 5 [label=\"CO: L5\\n" ++ - "OO: 50: CALLVALUE\\n" ++ - "OO: 51: PUSH [96]\\n" ++ - "OO: 53: SWAP1\\n" ++ - "OO: 54: DUP2\\n" ++ - "OO: 55: MSTORE\\n" ++ - "OO: 56: PUSH [88]\\n" ++ - "OO: 58: SWAP1\\n" ++ - "OO: 59: PUSH [1]\\n" ++ - "OO: 61: PUSH [160]\\n" ++ - "OO: 63: PUSH [2]\\n" ++ - "OO: 65: EXP\\n" ++ - "OO: 66: SUB\\n" ++ - "OO: 67: CALLER\\n" ++ - "OO: 68: AND\\n" ++ - "OO: 69: SWAP1\\n" ++ - "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\\n" ++ - "OO: 103: SWAP1\\n" ++ - "OO: 104: PUSH [32]\\n" ++ - "OO: 106: SWAP1\\n" ++ - "OC: 107: LOG3 -> [L6]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 6 [label=\"CO: L6\\n" ++ - "OO: 108: JUMPDEST\\n" ++ - "OC: 109: JUMP -> []\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 7 [label=\"CO: L7\\n" ++ - "OO: 110: JUMPDEST\\n" ++ - "OO: 111: PUSH [213]\\n" ++ - "OO: 113: PUSH [0]\\n" ++ - "OO: 115: SLOAD\\n" ++ - "OO: 116: PUSH [1]\\n" ++ - "OO: 118: PUSH [160]\\n" ++ - "OO: 120: PUSH [2]\\n" ++ - "OO: 122: EXP\\n" ++ - "OO: 123: SUB\\n" ++ - "OO: 124: SWAP1\\n" ++ - "OO: 125: DUP2\\n" ++ - "OO: 126: AND\\n" ++ - "OO: 127: CALLER\\n" ++ - "OO: 128: SWAP2\\n" ++ - "OO: 129: SWAP1\\n" ++ - "OO: 130: SWAP2\\n" ++ - "OO: 131: AND\\n" ++ - "OO: 132: EQ\\n" ++ - "OO: 133: ISZERO\\n" ++ - "OO: 134: PUSH [108]\\n" ++ - "OC: 136: JUMPI -> [L8]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 8 [label=\"CO: L8\\n" ++ - "OO: 137: PUSH [0]\\n" ++ - "OO: 139: SLOAD\\n" ++ - "OO: 140: PUSH [1]\\n" ++ - "OO: 142: PUSH [160]\\n" ++ - "OO: 144: PUSH [2]\\n" ++ - "OO: 146: EXP\\n" ++ - "OO: 147: SUB\\n" ++ - "OO: 148: AND\\n" ++ - "OC: 149: SUICIDE -> []\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 9 [label=\"CO: L9\\n" ++ - "OO: 150: JUMPDEST\\n" ++ - "OO: 151: PUSH [213]\\n" ++ - "OO: 153: PUSH [0]\\n" ++ - "OO: 155: SLOAD\\n" ++ - "OO: 156: PUSH [1]\\n" ++ - "OO: 158: PUSH [160]\\n" ++ - "OO: 160: PUSH [2]\\n" ++ - "OO: 162: EXP\\n" ++ - "OO: 163: SUB\\n" ++ - "OO: 164: SWAP1\\n" ++ - "OO: 165: DUP2\\n" ++ - "OO: 166: AND\\n" ++ - "OO: 167: CALLER\\n" ++ - "OO: 168: SWAP2\\n" ++ - "OO: 169: SWAP1\\n" ++ - "OO: 170: SWAP2\\n" ++ - "OO: 171: AND\\n" ++ - "OO: 172: EQ\\n" ++ - "OO: 173: ISZERO\\n" ++ - "OO: 174: PUSH [108]\\n" ++ - "OC: 176: JUMPI -> [L10]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 10 [label=\"CO: L10\\n" ++ - "OO: 177: PUSH [0]\\n" ++ - "OO: 179: DUP1\\n" ++ - "OO: 180: SLOAD\\n" ++ - "OO: 181: PUSH [1]\\n" ++ - "OO: 183: PUSH [160]\\n" ++ - "OO: 185: PUSH [2]\\n" ++ - "OO: 187: EXP\\n" ++ - "OO: 188: SUB\\n" ++ - "OO: 189: SWAP1\\n" ++ - "OO: 190: DUP2\\n" ++ - "OO: 191: AND\\n" ++ - "OO: 192: SWAP2\\n" ++ - "OO: 193: SWAP1\\n" ++ - "OO: 194: ADDRESS\\n" ++ - "OO: 195: AND\\n" ++ - "OO: 196: BALANCE\\n" ++ - "OO: 197: PUSH [96]\\n" ++ - "OO: 199: DUP3\\n" ++ - "OO: 200: DUP2\\n" ++ - "OO: 201: DUP2\\n" ++ - "OO: 202: DUP2\\n" ++ - "OO: 203: DUP6\\n" ++ - "OO: 204: DUP9\\n" ++ - "OO: 205: DUP4\\n" ++ - "OC: 206: CALL -> [L11]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 11 [label=\"CO: L11\\n" ++ - "OO: 207: POP\\n" ++ - "OO: 208: POP\\n" ++ - "OO: 209: POP\\n" ++ - "OO: 210: POP\\n" ++ - "OO: 211: POP\\n" ++ - "OC: 212: JUMP -> []\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 12 [label=\"CO: L12\\n" ++ - "OO: 213: JUMPDEST\\n" ++ - "OC: 214: STOP -> []\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 1 -> 2;\n" ++ - " 2 -> 3;\n" ++ - " 3 -> 4;\n" ++ - " 4 -> 5;\n" ++ - " 5 -> 6;\n" ++ - " 7 -> 8;\n" ++ " 9 -> 10;\n" ++ " 10 -> 11;\n" ++ "}" - it "shows HplBody after CfgAugmentPass" $ - do let decompiled@((loc, _):_) = decompileHexString hexcode2 - result = - unWordLabelMapM $ - do contract <- evmOps2HplContract decompiled - unpack . toDotText . bodyOf . ctorOf <$> doCfgAugmentPass contract - result `shouldBe` "digraph {\n" ++ - " 1 [label=\"CO: L1\\n" ++ - "OO: 0: PUSH [96]\\n" ++ - "OO: 2: PUSH [64]\\n" ++ - "OO: 4: MSTORE\\n" ++ - "OO: 5: CALLDATASIZE\\n" ++ - "OO: 6: ISZERO\\n" ++ - "OO: 7: PUSH [39]\\n" ++ - "OC: 9: JUMPI -> [L2,L4]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 2 [label=\"CO: L2\\n" ++ - "OO: 10: PUSH [224]\\n" ++ - "OO: 12: PUSH [2]\\n" ++ - "OO: 14: EXP\\n" ++ - "OO: 15: PUSH [0]\\n" ++ - "OO: 17: CALLDATALOAD\\n" ++ - "OO: 18: DIV\\n" ++ - "OO: 19: PUSH [65,192,225,181]\\n" ++ - "OO: 24: DUP2\\n" ++ - "OO: 25: EQ\\n" ++ - "OO: 26: PUSH [110]\\n" ++ - "OC: 28: JUMPI -> [L3,L7]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 3 [label=\"CO: L3\\n" ++ - "OO: 29: DUP1\\n" ++ - "OO: 30: PUSH [229,34,83,129]\\n" ++ - "OO: 35: EQ\\n" ++ - "OO: 36: PUSH [150]\\n" ++ - "OC: 38: JUMPI -> [L4,L9]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 4 [label=\"CO: L4\\n" ++ - "OO: 39: JUMPDEST\\n" ++ - "OO: 40: PUSH [213]\\n" ++ - "OO: 42: PUSH [0]\\n" ++ - "OO: 44: CALLVALUE\\n" ++ - "OO: 45: GT\\n" ++ - "OO: 46: ISZERO\\n" ++ - "OO: 47: PUSH [108]\\n" ++ - "OC: 49: JUMPI -> [L5,L6]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 5 [label=\"CO: L5\\n" ++ - "OO: 50: CALLVALUE\\n" ++ - "OO: 51: PUSH [96]\\n" ++ - "OO: 53: SWAP1\\n" ++ - "OO: 54: DUP2\\n" ++ - "OO: 55: MSTORE\\n" ++ - "OO: 56: PUSH [88]\\n" ++ - "OO: 58: SWAP1\\n" ++ - "OO: 59: PUSH [1]\\n" ++ - "OO: 61: PUSH [160]\\n" ++ - "OO: 63: PUSH [2]\\n" ++ - "OO: 65: EXP\\n" ++ - "OO: 66: SUB\\n" ++ - "OO: 67: CALLER\\n" ++ - "OO: 68: AND\\n" ++ - "OO: 69: SWAP1\\n" ++ - "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\\n" ++ - "OO: 103: SWAP1\\n" ++ - "OO: 104: PUSH [32]\\n" ++ - "OO: 106: SWAP1\\n" ++ - "OC: 107: LOG3 -> [L6]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 6 [label=\"CO: L6\\n" ++ - "OO: 108: JUMPDEST\\n" ++ - "OC: 109: JUMP -> []\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 7 [label=\"CO: L7\\n" ++ - "OO: 110: JUMPDEST\\n" ++ - "OO: 111: PUSH [213]\\n" ++ - "OO: 113: PUSH [0]\\n" ++ - "OO: 115: SLOAD\\n" ++ - "OO: 116: PUSH [1]\\n" ++ - "OO: 118: PUSH [160]\\n" ++ - "OO: 120: PUSH [2]\\n" ++ - "OO: 122: EXP\\n" ++ - "OO: 123: SUB\\n" ++ - "OO: 124: SWAP1\\n" ++ - "OO: 125: DUP2\\n" ++ - "OO: 126: AND\\n" ++ - "OO: 127: CALLER\\n" ++ - "OO: 128: SWAP2\\n" ++ - "OO: 129: SWAP1\\n" ++ - "OO: 130: SWAP2\\n" ++ - "OO: 131: AND\\n" ++ - "OO: 132: EQ\\n" ++ - "OO: 133: ISZERO\\n" ++ - "OO: 134: PUSH [108]\\n" ++ - "OC: 136: JUMPI -> [L6,L8]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 8 [label=\"CO: L8\\n" ++ - "OO: 137: PUSH [0]\\n" ++ - "OO: 139: SLOAD\\n" ++ - "OO: 140: PUSH [1]\\n" ++ - "OO: 142: PUSH [160]\\n" ++ - "OO: 144: PUSH [2]\\n" ++ - "OO: 146: EXP\\n" ++ - "OO: 147: SUB\\n" ++ - "OO: 148: AND\\n" ++ - "OC: 149: SUICIDE -> []\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 9 [label=\"CO: L9\\n" ++ - "OO: 150: JUMPDEST\\n" ++ - "OO: 151: PUSH [213]\\n" ++ - "OO: 153: PUSH [0]\\n" ++ - "OO: 155: SLOAD\\n" ++ - "OO: 156: PUSH [1]\\n" ++ - "OO: 158: PUSH [160]\\n" ++ - "OO: 160: PUSH [2]\\n" ++ - "OO: 162: EXP\\n" ++ - "OO: 163: SUB\\n" ++ - "OO: 164: SWAP1\\n" ++ - "OO: 165: DUP2\\n" ++ - "OO: 166: AND\\n" ++ - "OO: 167: CALLER\\n" ++ - "OO: 168: SWAP2\\n" ++ - "OO: 169: SWAP1\\n" ++ - "OO: 170: SWAP2\\n" ++ - "OO: 171: AND\\n" ++ - "OO: 172: EQ\\n" ++ - "OO: 173: ISZERO\\n" ++ - "OO: 174: PUSH [108]\\n" ++ - "OC: 176: JUMPI -> [L6,L10]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 10 [label=\"CO: L10\\n" ++ - "OO: 177: PUSH [0]\\n" ++ - "OO: 179: DUP1\\n" ++ - "OO: 180: SLOAD\\n" ++ - "OO: 181: PUSH [1]\\n" ++ - "OO: 183: PUSH [160]\\n" ++ - "OO: 185: PUSH [2]\\n" ++ - "OO: 187: EXP\\n" ++ - "OO: 188: SUB\\n" ++ - "OO: 189: SWAP1\\n" ++ - "OO: 190: DUP2\\n" ++ - "OO: 191: AND\\n" ++ - "OO: 192: SWAP2\\n" ++ - "OO: 193: SWAP1\\n" ++ - "OO: 194: ADDRESS\\n" ++ - "OO: 195: AND\\n" ++ - "OO: 196: BALANCE\\n" ++ - "OO: 197: PUSH [96]\\n" ++ - "OO: 199: DUP3\\n" ++ - "OO: 200: DUP2\\n" ++ - "OO: 201: DUP2\\n" ++ - "OO: 202: DUP2\\n" ++ - "OO: 203: DUP6\\n" ++ - "OO: 204: DUP9\\n" ++ - "OO: 205: DUP4\\n" ++ - "OC: 206: CALL -> [L11]\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 11 [label=\"CO: L11\\n" ++ - "OO: 207: POP\\n" ++ - "OO: 208: POP\\n" ++ - "OO: 209: POP\\n" ++ - "OO: 210: POP\\n" ++ - "OO: 211: POP\\n" ++ - "OC: 212: JUMP -> []\\n" ++ - "\"\n" ++ - " ,shape=box];\n" ++ - " 1 -> 2;\n" ++ - " 1 -> 4;\n" ++ - " 2 -> 3;\n" ++ - " 2 -> 7;\n" ++ - " 3 -> 4;\n" ++ - " 3 -> 9;\n" ++ - " 4 -> 5;\n" ++ - " 4 -> 6;\n" ++ - " 5 -> 6;\n" ++ - " 7 -> 6;\n" ++ - " 7 -> 8;\n" ++ - " 9 -> 6;\n" ++ " 9 -> 10;\n" ++ " 10 -> 11;\n" ++ "}" diff --git a/test/Blockchain/AnalyzeSpec.hs b/test/Blockchain/AnalyzeSpec.hs deleted file mode 100644 --- a/test/Blockchain/AnalyzeSpec.hs +++ /dev/null @@ -1,161 +0,0 @@ -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} - -module Blockchain.AnalyzeSpec - ( spec - ) where - -import Blockchain.Analyze -import Blockchain.ExtWord -import Blockchain.VM.Opcodes -import Data.List as DL -import Data.List.Extra as DLE -import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord -import SpecCommon -import Test.Hspec - -spec :: Spec -spec = do - describe "decompile" $ - do it "works for hexcode1" $ - do let decompiled1 = show $ showOps $ decompileHexString hexcode1 - DL.take 60 decompiled1 `shouldBe` - "[\"0: PUSH [96]\",\"2: PUSH [64]\",\"4: MSTORE\",\"5: PUSH [2]\",\"7:" - DLE.takeEnd 60 decompiled1 `shouldBe` - "]\",\"6989: JUMP\",\"6990: JUMPDEST\",\"6991: SWAP1\",\"6992: JUMP\"]" - it "works for hexcode2" $ - do let decompiled2 = show $ showOps $ decompileHexString hexcode2 - decompiled2 `shouldBe` "[\"0: PUSH [96]\"," ++ - "\"2: PUSH [64]\"," ++ - "\"4: MSTORE\"," ++ - "\"5: CALLDATASIZE\"," ++ - "\"6: ISZERO\"," ++ - "\"7: PUSH [39]\"," ++ - "\"9: JUMPI\"," ++ - "\"10: PUSH [224]\"," ++ - "\"12: PUSH [2]\"," ++ - "\"14: EXP\"," ++ - "\"15: PUSH [0]\"," ++ - "\"17: CALLDATALOAD\"," ++ - "\"18: DIV\"," ++ - "\"19: PUSH [65,192,225,181]\"," ++ - "\"24: DUP2\"," ++ - "\"25: EQ\"," ++ - "\"26: PUSH [110]\"," ++ - "\"28: JUMPI\"," ++ - "\"29: DUP1\"," ++ - "\"30: PUSH [229,34,83,129]\"," ++ - "\"35: EQ\"," ++ - "\"36: PUSH [150]\"," ++ - "\"38: JUMPI\"," ++ - "\"39: JUMPDEST\"," ++ - "\"40: PUSH [213]\"," ++ - "\"42: PUSH [0]\"," ++ - "\"44: CALLVALUE\"," ++ - "\"45: GT\"," ++ - "\"46: ISZERO\"," ++ - "\"47: PUSH [108]\"," ++ - "\"49: JUMPI\"," ++ - "\"50: CALLVALUE\"," ++ - "\"51: PUSH [96]\"," ++ - "\"53: SWAP1\"," ++ - "\"54: DUP2\"," ++ - "\"55: MSTORE\"," ++ - "\"56: PUSH [88]\"," ++ - "\"58: SWAP1\"," ++ - "\"59: PUSH [1]\"," ++ - "\"61: PUSH [160]\"," ++ - "\"63: PUSH [2]\"," ++ - "\"65: EXP\"," ++ - "\"66: SUB\"," ++ - "\"67: CALLER\"," ++ - "\"68: AND\"," ++ - "\"69: SWAP1\"," ++ - "\"70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\"," ++ - "\"103: SWAP1\"," ++ - "\"104: PUSH [32]\"," ++ - "\"106: SWAP1\"," ++ - "\"107: LOG3\"," ++ - "\"108: JUMPDEST\"," ++ - "\"109: JUMP\"," ++ - "\"110: JUMPDEST\"," ++ - "\"111: PUSH [213]\"," ++ - "\"113: PUSH [0]\"," ++ - "\"115: SLOAD\"," ++ - "\"116: PUSH [1]\"," ++ - "\"118: PUSH [160]\"," ++ - "\"120: PUSH [2]\"," ++ - "\"122: EXP\"," ++ - "\"123: SUB\"," ++ - "\"124: SWAP1\"," ++ - "\"125: DUP2\"," ++ - "\"126: AND\"," ++ - "\"127: CALLER\"," ++ - "\"128: SWAP2\"," ++ - "\"129: SWAP1\"," ++ - "\"130: SWAP2\"," ++ - "\"131: AND\"," ++ - "\"132: EQ\"," ++ - "\"133: ISZERO\"," ++ - "\"134: PUSH [108]\"," ++ - "\"136: JUMPI\"," ++ - "\"137: PUSH [0]\"," ++ - "\"139: SLOAD\"," ++ - "\"140: PUSH [1]\"," ++ - "\"142: PUSH [160]\"," ++ - "\"144: PUSH [2]\"," ++ - "\"146: EXP\"," ++ - "\"147: SUB\"," ++ - "\"148: AND\"," ++ - "\"149: SUICIDE\"," ++ - "\"150: JUMPDEST\"," ++ - "\"151: PUSH [213]\"," ++ - "\"153: PUSH [0]\"," ++ - "\"155: SLOAD\"," ++ - "\"156: PUSH [1]\"," ++ - "\"158: PUSH [160]\"," ++ - "\"160: PUSH [2]\"," ++ - "\"162: EXP\"," ++ - "\"163: SUB\"," ++ - "\"164: SWAP1\"," ++ - "\"165: DUP2\"," ++ - "\"166: AND\"," ++ - "\"167: CALLER\"," ++ - "\"168: SWAP2\"," ++ - "\"169: SWAP1\"," ++ - "\"170: SWAP2\"," ++ - "\"171: AND\"," ++ - "\"172: EQ\"," ++ - "\"173: ISZERO\"," ++ - "\"174: PUSH [108]\"," ++ - "\"176: JUMPI\"," ++ - "\"177: PUSH [0]\"," ++ - "\"179: DUP1\"," ++ - "\"180: SLOAD\"," ++ - "\"181: PUSH [1]\"," ++ - "\"183: PUSH [160]\"," ++ - "\"185: PUSH [2]\"," ++ - "\"187: EXP\"," ++ - "\"188: SUB\"," ++ - "\"189: SWAP1\"," ++ - "\"190: DUP2\"," ++ - "\"191: AND\"," ++ - "\"192: SWAP2\"," ++ - "\"193: SWAP1\"," ++ - "\"194: ADDRESS\"," ++ - "\"195: AND\"," ++ - "\"196: BALANCE\"," ++ - "\"197: PUSH [96]\"," ++ - "\"199: DUP3\"," ++ - "\"200: DUP2\"," ++ - "\"201: DUP2\"," ++ - "\"202: DUP2\"," ++ - "\"203: DUP6\"," ++ - "\"204: DUP9\"," ++ - "\"205: DUP4\"," ++ - "\"206: CALL\"," ++ - "\"207: POP\"," ++ - "\"208: POP\"," ++ - "\"209: POP\"," ++ - "\"210: POP\"," ++ - "\"211: POP\"," ++ - "\"212: JUMP\"," ++ "\"213: JUMPDEST\"," ++ "\"214: STOP\"]" diff --git a/test/Ethereum/Analyzer/CfgAugWithTopNPassSpec.hs b/test/Ethereum/Analyzer/CfgAugWithTopNPassSpec.hs new file mode 100644 --- /dev/null +++ b/test/Ethereum/Analyzer/CfgAugWithTopNPassSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} + +module Ethereum.Analyzer.CfgAugWithTopNPassSpec + ( spec + ) where + +import Ethereum.Analyzer +import Ethereum.Analyzer.CfgAugWithTopNPass +import SpecCommon +import Test.Hspec + +spec :: Spec +spec = do + describe "doCfgAugWithTopNPass" $ + do it "works for hexcode1" $ + do let result = + unWordLabelMapM $ + show <$> doCfgAugWithTopNPass hexcode1 + length result `shouldBe` 4815 + it "works for hexcode2" $ + do let result = + unWordLabelMapM $ + show <$> doCfgAugWithTopNPass hexcode2 + result `shouldContain` "OC: 9: JUMPI -> [L2,L4]" diff --git a/test/Ethereum/Analyzer/CfgAugmentPassSpec.hs b/test/Ethereum/Analyzer/CfgAugmentPassSpec.hs new file mode 100644 --- /dev/null +++ b/test/Ethereum/Analyzer/CfgAugmentPassSpec.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} + +module Ethereum.Analyzer.CfgAugmentPassSpec + ( spec + ) where + +import Ethereum.Analyzer +import Ethereum.Analyzer.CfgAugmentPass +import SpecCommon +import Test.Hspec + +spec :: Spec +spec = do + describe "doCfgAugmentPass" $ + do it "works for hexcode1" $ + do let decompiled = decompileHexString hexcode1 + result = + unWordLabelMapM $ + do contract <- evmOps2HplContract decompiled + show <$> doCfgAugmentPass contract + length result `shouldBe` 4769 + it "works for hexcode2" $ + do let decompiled@((loc, _):_) = decompileHexString hexcode2 + result = + unWordLabelMapM $ + do contract <- evmOps2HplContract decompiled + show . bodyOf . ctorOf <$> doCfgAugmentPass contract + result `shouldBe` "LM (UM (fromList [(1,CO: L1\n" ++ + "OO: 0: PUSH [96]\n" ++ + "OO: 2: PUSH [64]\n" ++ + "OO: 4: MSTORE\n" ++ + "OO: 5: CALLDATASIZE\n" ++ + "OO: 6: ISZERO\n" ++ + "OO: 7: PUSH [39]\n" ++ + "OC: 9: JUMPI -> [L2,L4]\n" ++ + "),(2,CO: L2\n" ++ + "OO: 10: PUSH [224]\n" ++ + "OO: 12: PUSH [2]\n" ++ + "OO: 14: EXP\n" ++ + "OO: 15: PUSH [0]\n" ++ + "OO: 17: CALLDATALOAD\n" ++ + "OO: 18: DIV\n" ++ + "OO: 19: PUSH [65,192,225,181]\n" ++ + "OO: 24: DUP2\n" ++ + "OO: 25: EQ\n" ++ + "OO: 26: PUSH [110]\n" ++ + "OC: 28: JUMPI -> [L3,L7]\n" ++ + "),(3,CO: L3\n" ++ + "OO: 29: DUP1\n" ++ + "OO: 30: PUSH [229,34,83,129]\n" ++ + "OO: 35: EQ\n" ++ + "OO: 36: PUSH [150]\n" ++ + "OC: 38: JUMPI -> [L4,L9]\n" ++ + "),(4,CO: L4\n" ++ + "OO: 39: JUMPDEST\n" ++ + "OO: 40: PUSH [213]\n" ++ + "OO: 42: PUSH [0]\n" ++ + "OO: 44: CALLVALUE\n" ++ + "OO: 45: GT\n" ++ + "OO: 46: ISZERO\n" ++ + "OO: 47: PUSH [108]\n" ++ + "OC: 49: JUMPI -> [L5,L6]\n" ++ + "),(5,CO: L5\n" ++ + "OO: 50: CALLVALUE\n" ++ + "OO: 51: PUSH [96]\n" ++ + "OO: 53: SWAP1\n" ++ + "OO: 54: DUP2\n" ++ + "OO: 55: MSTORE\n" ++ + "OO: 56: PUSH [88]\n" ++ + "OO: 58: SWAP1\n" ++ + "OO: 59: PUSH [1]\n" ++ + "OO: 61: PUSH [160]\n" ++ + "OO: 63: PUSH [2]\n" ++ + "OO: 65: EXP\n" ++ + "OO: 66: SUB\n" ++ + "OO: 67: CALLER\n" ++ + "OO: 68: AND\n" ++ + "OO: 69: SWAP1\n" ++ + "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\n" ++ + "OO: 103: SWAP1\n" ++ + "OO: 104: PUSH [32]\n" ++ + "OO: 106: SWAP1\n" ++ + "OC: 107: LOG3 -> [L6]\n" ++ + "),(6,CO: L6\n" ++ + "OO: 108: JUMPDEST\n" ++ + "OC: 109: JUMP -> []\n" ++ + "),(7,CO: L7\n" ++ + "OO: 110: JUMPDEST\n" ++ + "OO: 111: PUSH [213]\n" ++ + "OO: 113: PUSH [0]\n" ++ + "OO: 115: SLOAD\n" ++ + "OO: 116: PUSH [1]\n" ++ + "OO: 118: PUSH [160]\n" ++ + "OO: 120: PUSH [2]\n" ++ + "OO: 122: EXP\n" ++ + "OO: 123: SUB\n" ++ + "OO: 124: SWAP1\n" ++ + "OO: 125: DUP2\n" ++ + "OO: 126: AND\n" ++ + "OO: 127: CALLER\n" ++ + "OO: 128: SWAP2\n" ++ + "OO: 129: SWAP1\n" ++ + "OO: 130: SWAP2\n" ++ + "OO: 131: AND\n" ++ + "OO: 132: EQ\n" ++ + "OO: 133: ISZERO\n" ++ + "OO: 134: PUSH [108]\n" ++ + "OC: 136: JUMPI -> [L6,L8]\n" ++ + "),(8,CO: L8\n" ++ + "OO: 137: PUSH [0]\n" ++ + "OO: 139: SLOAD\n" ++ + "OO: 140: PUSH [1]\n" ++ + "OO: 142: PUSH [160]\n" ++ + "OO: 144: PUSH [2]\n" ++ + "OO: 146: EXP\n" ++ + "OO: 147: SUB\n" ++ + "OO: 148: AND\n" ++ + "OC: 149: SUICIDE -> []\n" ++ + "),(9,CO: L9\n" ++ + "OO: 150: JUMPDEST\n" ++ + "OO: 151: PUSH [213]\n" ++ + "OO: 153: PUSH [0]\n" ++ + "OO: 155: SLOAD\n" ++ + "OO: 156: PUSH [1]\n" ++ + "OO: 158: PUSH [160]\n" ++ + "OO: 160: PUSH [2]\n" ++ + "OO: 162: EXP\n" ++ + "OO: 163: SUB\n" ++ + "OO: 164: SWAP1\n" ++ + "OO: 165: DUP2\n" ++ + "OO: 166: AND\n" ++ + "OO: 167: CALLER\n" ++ + "OO: 168: SWAP2\n" ++ + "OO: 169: SWAP1\n" ++ + "OO: 170: SWAP2\n" ++ + "OO: 171: AND\n" ++ + "OO: 172: EQ\n" ++ + "OO: 173: ISZERO\n" ++ + "OO: 174: PUSH [108]\n" ++ + "OC: 176: JUMPI -> [L6,L10]\n" ++ + "),(10,CO: L10\n" ++ + "OO: 177: PUSH [0]\n" ++ + "OO: 179: DUP1\n" ++ + "OO: 180: SLOAD\n" ++ + "OO: 181: PUSH [1]\n" ++ + "OO: 183: PUSH [160]\n" ++ + "OO: 185: PUSH [2]\n" ++ + "OO: 187: EXP\n" ++ + "OO: 188: SUB\n" ++ + "OO: 189: SWAP1\n" ++ + "OO: 190: DUP2\n" ++ + "OO: 191: AND\n" ++ + "OO: 192: SWAP2\n" ++ + "OO: 193: SWAP1\n" ++ + "OO: 194: ADDRESS\n" ++ + "OO: 195: AND\n" ++ + "OO: 196: BALANCE\n" ++ + "OO: 197: PUSH [96]\n" ++ + "OO: 199: DUP3\n" ++ + "OO: 200: DUP2\n" ++ + "OO: 201: DUP2\n" ++ + "OO: 202: DUP2\n" ++ + "OO: 203: DUP6\n" ++ + "OO: 204: DUP9\n" ++ + "OO: 205: DUP4\n" ++ + "OC: 206: CALL -> [L11]\n" ++ + "),(11,CO: L11\n" ++ + "OO: 207: POP\n" ++ + "OO: 208: POP\n" ++ + "OO: 209: POP\n" ++ + "OO: 210: POP\n" ++ + "OO: 211: POP\n" ++ "OC: 212: JUMP -> []\n" ++ ")]))" diff --git a/test/Ethereum/Analyzer/IRSpec.hs b/test/Ethereum/Analyzer/IRSpec.hs new file mode 100644 --- /dev/null +++ b/test/Ethereum/Analyzer/IRSpec.hs @@ -0,0 +1,177 @@ +module Ethereum.Analyzer.IRSpec + ( spec + ) where + +import Ethereum.Analyzer +import Compiler.Hoopl +import SpecCommon +import Test.Hspec + +spec :: Spec +spec = do + describe "e2h" $ + do it "works for hexcode1" $ + do let decompiled = decompileHexString hexcode1 + unWordLabelMapM + (mapSize . bodyOf . ctorOf <$> (evmOps2HplContract decompiled)) `shouldBe` + 327 + it "works for hexcode2" $ + do let decompiled = decompileHexString hexcode2 + unWordLabelMapM + (mapSize . bodyOf . ctorOf <$> (evmOps2HplContract decompiled)) `shouldBe` + 12 + -- it "shows voteHexcode" $ + -- do let decompiled = decompileHexString voteHexcode + -- unWordLabelMapM (show <$> (evmOps2HplBody decompiled)) `shouldBe` "" + it "shows HplBody" $ + do let decompiled = decompileHexString hexcode2 + unWordLabelMapM + (show . bodyOf . ctorOf <$> (evmOps2HplContract decompiled)) `shouldBe` + "LM (UM (fromList [(1,CO: L1\n" ++ + "OO: 0: PUSH [96]\n" ++ + "OO: 2: PUSH [64]\n" ++ + "OO: 4: MSTORE\n" ++ + "OO: 5: CALLDATASIZE\n" ++ + "OO: 6: ISZERO\n" ++ + "OO: 7: PUSH [39]\n" ++ + "OC: 9: JUMPI -> [L2]\n" ++ + "),(2,CO: L2\n" ++ + "OO: 10: PUSH [224]\n" ++ + "OO: 12: PUSH [2]\n" ++ + "OO: 14: EXP\n" ++ + "OO: 15: PUSH [0]\n" ++ + "OO: 17: CALLDATALOAD\n" ++ + "OO: 18: DIV\n" ++ + "OO: 19: PUSH [65,192,225,181]\n" ++ + "OO: 24: DUP2\n" ++ + "OO: 25: EQ\n" ++ + "OO: 26: PUSH [110]\n" ++ + "OC: 28: JUMPI -> [L3]\n" ++ + "),(3,CO: L3\n" ++ + "OO: 29: DUP1\n" ++ + "OO: 30: PUSH [229,34,83,129]\n" ++ + "OO: 35: EQ\n" ++ + "OO: 36: PUSH [150]\n" ++ + "OC: 38: JUMPI -> [L4]\n" ++ + "),(4,CO: L4\n" ++ + "OO: 39: JUMPDEST\n" ++ + "OO: 40: PUSH [213]\n" ++ + "OO: 42: PUSH [0]\n" ++ + "OO: 44: CALLVALUE\n" ++ + "OO: 45: GT\n" ++ + "OO: 46: ISZERO\n" ++ + "OO: 47: PUSH [108]\n" ++ + "OC: 49: JUMPI -> [L5]\n" ++ + "),(5,CO: L5\n" ++ + "OO: 50: CALLVALUE\n" ++ + "OO: 51: PUSH [96]\n" ++ + "OO: 53: SWAP1\n" ++ + "OO: 54: DUP2\n" ++ + "OO: 55: MSTORE\n" ++ + "OO: 56: PUSH [88]\n" ++ + "OO: 58: SWAP1\n" ++ + "OO: 59: PUSH [1]\n" ++ + "OO: 61: PUSH [160]\n" ++ + "OO: 63: PUSH [2]\n" ++ + "OO: 65: EXP\n" ++ + "OO: 66: SUB\n" ++ + "OO: 67: CALLER\n" ++ + "OO: 68: AND\n" ++ + "OO: 69: SWAP1\n" ++ + "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\n" ++ + "OO: 103: SWAP1\n" ++ + "OO: 104: PUSH [32]\n" ++ + "OO: 106: SWAP1\n" ++ + "OC: 107: LOG3 -> [L6]\n" ++ + "),(6,CO: L6\n" ++ + "OO: 108: JUMPDEST\n" ++ + "OC: 109: JUMP -> []\n" ++ + "),(7,CO: L7\n" ++ + "OO: 110: JUMPDEST\n" ++ + "OO: 111: PUSH [213]\n" ++ + "OO: 113: PUSH [0]\n" ++ + "OO: 115: SLOAD\n" ++ + "OO: 116: PUSH [1]\n" ++ + "OO: 118: PUSH [160]\n" ++ + "OO: 120: PUSH [2]\n" ++ + "OO: 122: EXP\n" ++ + "OO: 123: SUB\n" ++ + "OO: 124: SWAP1\n" ++ + "OO: 125: DUP2\n" ++ + "OO: 126: AND\n" ++ + "OO: 127: CALLER\n" ++ + "OO: 128: SWAP2\n" ++ + "OO: 129: SWAP1\n" ++ + "OO: 130: SWAP2\n" ++ + "OO: 131: AND\n" ++ + "OO: 132: EQ\n" ++ + "OO: 133: ISZERO\n" ++ + "OO: 134: PUSH [108]\n" ++ + "OC: 136: JUMPI -> [L8]\n" ++ + "),(8,CO: L8\n" ++ + "OO: 137: PUSH [0]\n" ++ + "OO: 139: SLOAD\n" ++ + "OO: 140: PUSH [1]\n" ++ + "OO: 142: PUSH [160]\n" ++ + "OO: 144: PUSH [2]\n" ++ + "OO: 146: EXP\n" ++ + "OO: 147: SUB\n" ++ + "OO: 148: AND\n" ++ + "OC: 149: SUICIDE -> []\n" ++ + "),(9,CO: L9\n" ++ + "OO: 150: JUMPDEST\n" ++ + "OO: 151: PUSH [213]\n" ++ + "OO: 153: PUSH [0]\n" ++ + "OO: 155: SLOAD\n" ++ + "OO: 156: PUSH [1]\n" ++ + "OO: 158: PUSH [160]\n" ++ + "OO: 160: PUSH [2]\n" ++ + "OO: 162: EXP\n" ++ + "OO: 163: SUB\n" ++ + "OO: 164: SWAP1\n" ++ + "OO: 165: DUP2\n" ++ + "OO: 166: AND\n" ++ + "OO: 167: CALLER\n" ++ + "OO: 168: SWAP2\n" ++ + "OO: 169: SWAP1\n" ++ + "OO: 170: SWAP2\n" ++ + "OO: 171: AND\n" ++ + "OO: 172: EQ\n" ++ + "OO: 173: ISZERO\n" ++ + "OO: 174: PUSH [108]\n" ++ + "OC: 176: JUMPI -> [L10]\n" ++ + "),(10,CO: L10\n" ++ + "OO: 177: PUSH [0]\n" ++ + "OO: 179: DUP1\n" ++ + "OO: 180: SLOAD\n" ++ + "OO: 181: PUSH [1]\n" ++ + "OO: 183: PUSH [160]\n" ++ + "OO: 185: PUSH [2]\n" ++ + "OO: 187: EXP\n" ++ + "OO: 188: SUB\n" ++ + "OO: 189: SWAP1\n" ++ + "OO: 190: DUP2\n" ++ + "OO: 191: AND\n" ++ + "OO: 192: SWAP2\n" ++ + "OO: 193: SWAP1\n" ++ + "OO: 194: ADDRESS\n" ++ + "OO: 195: AND\n" ++ + "OO: 196: BALANCE\n" ++ + "OO: 197: PUSH [96]\n" ++ + "OO: 199: DUP3\n" ++ + "OO: 200: DUP2\n" ++ + "OO: 201: DUP2\n" ++ + "OO: 202: DUP2\n" ++ + "OO: 203: DUP6\n" ++ + "OO: 204: DUP9\n" ++ + "OO: 205: DUP4\n" ++ + "OC: 206: CALL -> [L11]\n" ++ + "),(11,CO: L11\n" ++ + "OO: 207: POP\n" ++ + "OO: 208: POP\n" ++ + "OO: 209: POP\n" ++ + "OO: 210: POP\n" ++ + "OO: 211: POP\n" ++ + "OC: 212: JUMP -> []\n" ++ + "),(12,CO: L12\n" ++ + "OO: 213: JUMPDEST\n" ++ "OC: 214: STOP -> []\n" ++ ")]))" diff --git a/test/Ethereum/Analyzer/UtilSpec.hs b/test/Ethereum/Analyzer/UtilSpec.hs new file mode 100644 --- /dev/null +++ b/test/Ethereum/Analyzer/UtilSpec.hs @@ -0,0 +1,386 @@ +module Ethereum.Analyzer.UtilSpec + ( spec + ) where + +import Ethereum.Analyzer +import Ethereum.Analyzer.CfgAugmentPass +import Ethereum.Analyzer.Util +import Data.Text +import SpecCommon +import Test.Hspec + +spec :: Spec +spec = do + describe "toDotText" $ + do it "shows HplBody's dot graph" $ + do let decompiled = decompileHexString hexcode2 + unWordLabelMapM + (unpack . toDotText . bodyOf . ctorOf <$> + (evmOps2HplContract decompiled)) `shouldBe` + "digraph {\n" ++ + " 1 [label=\"CO: L1\\n" ++ + "OO: 0: PUSH [96]\\n" ++ + "OO: 2: PUSH [64]\\n" ++ + "OO: 4: MSTORE\\n" ++ + "OO: 5: CALLDATASIZE\\n" ++ + "OO: 6: ISZERO\\n" ++ + "OO: 7: PUSH [39]\\n" ++ + "OC: 9: JUMPI -> [L2]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 2 [label=\"CO: L2\\n" ++ + "OO: 10: PUSH [224]\\n" ++ + "OO: 12: PUSH [2]\\n" ++ + "OO: 14: EXP\\n" ++ + "OO: 15: PUSH [0]\\n" ++ + "OO: 17: CALLDATALOAD\\n" ++ + "OO: 18: DIV\\n" ++ + "OO: 19: PUSH [65,192,225,181]\\n" ++ + "OO: 24: DUP2\\n" ++ + "OO: 25: EQ\\n" ++ + "OO: 26: PUSH [110]\\n" ++ + "OC: 28: JUMPI -> [L3]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 3 [label=\"CO: L3\\n" ++ + "OO: 29: DUP1\\n" ++ + "OO: 30: PUSH [229,34,83,129]\\n" ++ + "OO: 35: EQ\\n" ++ + "OO: 36: PUSH [150]\\n" ++ + "OC: 38: JUMPI -> [L4]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 4 [label=\"CO: L4\\n" ++ + "OO: 39: JUMPDEST\\n" ++ + "OO: 40: PUSH [213]\\n" ++ + "OO: 42: PUSH [0]\\n" ++ + "OO: 44: CALLVALUE\\n" ++ + "OO: 45: GT\\n" ++ + "OO: 46: ISZERO\\n" ++ + "OO: 47: PUSH [108]\\n" ++ + "OC: 49: JUMPI -> [L5]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 5 [label=\"CO: L5\\n" ++ + "OO: 50: CALLVALUE\\n" ++ + "OO: 51: PUSH [96]\\n" ++ + "OO: 53: SWAP1\\n" ++ + "OO: 54: DUP2\\n" ++ + "OO: 55: MSTORE\\n" ++ + "OO: 56: PUSH [88]\\n" ++ + "OO: 58: SWAP1\\n" ++ + "OO: 59: PUSH [1]\\n" ++ + "OO: 61: PUSH [160]\\n" ++ + "OO: 63: PUSH [2]\\n" ++ + "OO: 65: EXP\\n" ++ + "OO: 66: SUB\\n" ++ + "OO: 67: CALLER\\n" ++ + "OO: 68: AND\\n" ++ + "OO: 69: SWAP1\\n" ++ + "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\\n" ++ + "OO: 103: SWAP1\\n" ++ + "OO: 104: PUSH [32]\\n" ++ + "OO: 106: SWAP1\\n" ++ + "OC: 107: LOG3 -> [L6]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 6 [label=\"CO: L6\\n" ++ + "OO: 108: JUMPDEST\\n" ++ + "OC: 109: JUMP -> []\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 7 [label=\"CO: L7\\n" ++ + "OO: 110: JUMPDEST\\n" ++ + "OO: 111: PUSH [213]\\n" ++ + "OO: 113: PUSH [0]\\n" ++ + "OO: 115: SLOAD\\n" ++ + "OO: 116: PUSH [1]\\n" ++ + "OO: 118: PUSH [160]\\n" ++ + "OO: 120: PUSH [2]\\n" ++ + "OO: 122: EXP\\n" ++ + "OO: 123: SUB\\n" ++ + "OO: 124: SWAP1\\n" ++ + "OO: 125: DUP2\\n" ++ + "OO: 126: AND\\n" ++ + "OO: 127: CALLER\\n" ++ + "OO: 128: SWAP2\\n" ++ + "OO: 129: SWAP1\\n" ++ + "OO: 130: SWAP2\\n" ++ + "OO: 131: AND\\n" ++ + "OO: 132: EQ\\n" ++ + "OO: 133: ISZERO\\n" ++ + "OO: 134: PUSH [108]\\n" ++ + "OC: 136: JUMPI -> [L8]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 8 [label=\"CO: L8\\n" ++ + "OO: 137: PUSH [0]\\n" ++ + "OO: 139: SLOAD\\n" ++ + "OO: 140: PUSH [1]\\n" ++ + "OO: 142: PUSH [160]\\n" ++ + "OO: 144: PUSH [2]\\n" ++ + "OO: 146: EXP\\n" ++ + "OO: 147: SUB\\n" ++ + "OO: 148: AND\\n" ++ + "OC: 149: SUICIDE -> []\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 9 [label=\"CO: L9\\n" ++ + "OO: 150: JUMPDEST\\n" ++ + "OO: 151: PUSH [213]\\n" ++ + "OO: 153: PUSH [0]\\n" ++ + "OO: 155: SLOAD\\n" ++ + "OO: 156: PUSH [1]\\n" ++ + "OO: 158: PUSH [160]\\n" ++ + "OO: 160: PUSH [2]\\n" ++ + "OO: 162: EXP\\n" ++ + "OO: 163: SUB\\n" ++ + "OO: 164: SWAP1\\n" ++ + "OO: 165: DUP2\\n" ++ + "OO: 166: AND\\n" ++ + "OO: 167: CALLER\\n" ++ + "OO: 168: SWAP2\\n" ++ + "OO: 169: SWAP1\\n" ++ + "OO: 170: SWAP2\\n" ++ + "OO: 171: AND\\n" ++ + "OO: 172: EQ\\n" ++ + "OO: 173: ISZERO\\n" ++ + "OO: 174: PUSH [108]\\n" ++ + "OC: 176: JUMPI -> [L10]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 10 [label=\"CO: L10\\n" ++ + "OO: 177: PUSH [0]\\n" ++ + "OO: 179: DUP1\\n" ++ + "OO: 180: SLOAD\\n" ++ + "OO: 181: PUSH [1]\\n" ++ + "OO: 183: PUSH [160]\\n" ++ + "OO: 185: PUSH [2]\\n" ++ + "OO: 187: EXP\\n" ++ + "OO: 188: SUB\\n" ++ + "OO: 189: SWAP1\\n" ++ + "OO: 190: DUP2\\n" ++ + "OO: 191: AND\\n" ++ + "OO: 192: SWAP2\\n" ++ + "OO: 193: SWAP1\\n" ++ + "OO: 194: ADDRESS\\n" ++ + "OO: 195: AND\\n" ++ + "OO: 196: BALANCE\\n" ++ + "OO: 197: PUSH [96]\\n" ++ + "OO: 199: DUP3\\n" ++ + "OO: 200: DUP2\\n" ++ + "OO: 201: DUP2\\n" ++ + "OO: 202: DUP2\\n" ++ + "OO: 203: DUP6\\n" ++ + "OO: 204: DUP9\\n" ++ + "OO: 205: DUP4\\n" ++ + "OC: 206: CALL -> [L11]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 11 [label=\"CO: L11\\n" ++ + "OO: 207: POP\\n" ++ + "OO: 208: POP\\n" ++ + "OO: 209: POP\\n" ++ + "OO: 210: POP\\n" ++ + "OO: 211: POP\\n" ++ + "OC: 212: JUMP -> []\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 12 [label=\"CO: L12\\n" ++ + "OO: 213: JUMPDEST\\n" ++ + "OC: 214: STOP -> []\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 1 -> 2;\n" ++ + " 2 -> 3;\n" ++ + " 3 -> 4;\n" ++ + " 4 -> 5;\n" ++ + " 5 -> 6;\n" ++ + " 7 -> 8;\n" ++ " 9 -> 10;\n" ++ " 10 -> 11;\n" ++ "}" + it "shows HplBody after CfgAugmentPass" $ + do let decompiled@((loc, _):_) = decompileHexString hexcode2 + result = + unWordLabelMapM $ + do contract <- evmOps2HplContract decompiled + unpack . toDotText . bodyOf . ctorOf <$> doCfgAugmentPass contract + result `shouldBe` "digraph {\n" ++ + " 1 [label=\"CO: L1\\n" ++ + "OO: 0: PUSH [96]\\n" ++ + "OO: 2: PUSH [64]\\n" ++ + "OO: 4: MSTORE\\n" ++ + "OO: 5: CALLDATASIZE\\n" ++ + "OO: 6: ISZERO\\n" ++ + "OO: 7: PUSH [39]\\n" ++ + "OC: 9: JUMPI -> [L2,L4]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 2 [label=\"CO: L2\\n" ++ + "OO: 10: PUSH [224]\\n" ++ + "OO: 12: PUSH [2]\\n" ++ + "OO: 14: EXP\\n" ++ + "OO: 15: PUSH [0]\\n" ++ + "OO: 17: CALLDATALOAD\\n" ++ + "OO: 18: DIV\\n" ++ + "OO: 19: PUSH [65,192,225,181]\\n" ++ + "OO: 24: DUP2\\n" ++ + "OO: 25: EQ\\n" ++ + "OO: 26: PUSH [110]\\n" ++ + "OC: 28: JUMPI -> [L3,L7]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 3 [label=\"CO: L3\\n" ++ + "OO: 29: DUP1\\n" ++ + "OO: 30: PUSH [229,34,83,129]\\n" ++ + "OO: 35: EQ\\n" ++ + "OO: 36: PUSH [150]\\n" ++ + "OC: 38: JUMPI -> [L4,L9]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 4 [label=\"CO: L4\\n" ++ + "OO: 39: JUMPDEST\\n" ++ + "OO: 40: PUSH [213]\\n" ++ + "OO: 42: PUSH [0]\\n" ++ + "OO: 44: CALLVALUE\\n" ++ + "OO: 45: GT\\n" ++ + "OO: 46: ISZERO\\n" ++ + "OO: 47: PUSH [108]\\n" ++ + "OC: 49: JUMPI -> [L5,L6]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 5 [label=\"CO: L5\\n" ++ + "OO: 50: CALLVALUE\\n" ++ + "OO: 51: PUSH [96]\\n" ++ + "OO: 53: SWAP1\\n" ++ + "OO: 54: DUP2\\n" ++ + "OO: 55: MSTORE\\n" ++ + "OO: 56: PUSH [88]\\n" ++ + "OO: 58: SWAP1\\n" ++ + "OO: 59: PUSH [1]\\n" ++ + "OO: 61: PUSH [160]\\n" ++ + "OO: 63: PUSH [2]\\n" ++ + "OO: 65: EXP\\n" ++ + "OO: 66: SUB\\n" ++ + "OO: 67: CALLER\\n" ++ + "OO: 68: AND\\n" ++ + "OO: 69: SWAP1\\n" ++ + "OO: 70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\\n" ++ + "OO: 103: SWAP1\\n" ++ + "OO: 104: PUSH [32]\\n" ++ + "OO: 106: SWAP1\\n" ++ + "OC: 107: LOG3 -> [L6]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 6 [label=\"CO: L6\\n" ++ + "OO: 108: JUMPDEST\\n" ++ + "OC: 109: JUMP -> []\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 7 [label=\"CO: L7\\n" ++ + "OO: 110: JUMPDEST\\n" ++ + "OO: 111: PUSH [213]\\n" ++ + "OO: 113: PUSH [0]\\n" ++ + "OO: 115: SLOAD\\n" ++ + "OO: 116: PUSH [1]\\n" ++ + "OO: 118: PUSH [160]\\n" ++ + "OO: 120: PUSH [2]\\n" ++ + "OO: 122: EXP\\n" ++ + "OO: 123: SUB\\n" ++ + "OO: 124: SWAP1\\n" ++ + "OO: 125: DUP2\\n" ++ + "OO: 126: AND\\n" ++ + "OO: 127: CALLER\\n" ++ + "OO: 128: SWAP2\\n" ++ + "OO: 129: SWAP1\\n" ++ + "OO: 130: SWAP2\\n" ++ + "OO: 131: AND\\n" ++ + "OO: 132: EQ\\n" ++ + "OO: 133: ISZERO\\n" ++ + "OO: 134: PUSH [108]\\n" ++ + "OC: 136: JUMPI -> [L6,L8]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 8 [label=\"CO: L8\\n" ++ + "OO: 137: PUSH [0]\\n" ++ + "OO: 139: SLOAD\\n" ++ + "OO: 140: PUSH [1]\\n" ++ + "OO: 142: PUSH [160]\\n" ++ + "OO: 144: PUSH [2]\\n" ++ + "OO: 146: EXP\\n" ++ + "OO: 147: SUB\\n" ++ + "OO: 148: AND\\n" ++ + "OC: 149: SUICIDE -> []\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 9 [label=\"CO: L9\\n" ++ + "OO: 150: JUMPDEST\\n" ++ + "OO: 151: PUSH [213]\\n" ++ + "OO: 153: PUSH [0]\\n" ++ + "OO: 155: SLOAD\\n" ++ + "OO: 156: PUSH [1]\\n" ++ + "OO: 158: PUSH [160]\\n" ++ + "OO: 160: PUSH [2]\\n" ++ + "OO: 162: EXP\\n" ++ + "OO: 163: SUB\\n" ++ + "OO: 164: SWAP1\\n" ++ + "OO: 165: DUP2\\n" ++ + "OO: 166: AND\\n" ++ + "OO: 167: CALLER\\n" ++ + "OO: 168: SWAP2\\n" ++ + "OO: 169: SWAP1\\n" ++ + "OO: 170: SWAP2\\n" ++ + "OO: 171: AND\\n" ++ + "OO: 172: EQ\\n" ++ + "OO: 173: ISZERO\\n" ++ + "OO: 174: PUSH [108]\\n" ++ + "OC: 176: JUMPI -> [L6,L10]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 10 [label=\"CO: L10\\n" ++ + "OO: 177: PUSH [0]\\n" ++ + "OO: 179: DUP1\\n" ++ + "OO: 180: SLOAD\\n" ++ + "OO: 181: PUSH [1]\\n" ++ + "OO: 183: PUSH [160]\\n" ++ + "OO: 185: PUSH [2]\\n" ++ + "OO: 187: EXP\\n" ++ + "OO: 188: SUB\\n" ++ + "OO: 189: SWAP1\\n" ++ + "OO: 190: DUP2\\n" ++ + "OO: 191: AND\\n" ++ + "OO: 192: SWAP2\\n" ++ + "OO: 193: SWAP1\\n" ++ + "OO: 194: ADDRESS\\n" ++ + "OO: 195: AND\\n" ++ + "OO: 196: BALANCE\\n" ++ + "OO: 197: PUSH [96]\\n" ++ + "OO: 199: DUP3\\n" ++ + "OO: 200: DUP2\\n" ++ + "OO: 201: DUP2\\n" ++ + "OO: 202: DUP2\\n" ++ + "OO: 203: DUP6\\n" ++ + "OO: 204: DUP9\\n" ++ + "OO: 205: DUP4\\n" ++ + "OC: 206: CALL -> [L11]\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 11 [label=\"CO: L11\\n" ++ + "OO: 207: POP\\n" ++ + "OO: 208: POP\\n" ++ + "OO: 209: POP\\n" ++ + "OO: 210: POP\\n" ++ + "OO: 211: POP\\n" ++ + "OC: 212: JUMP -> []\\n" ++ + "\"\n" ++ + " ,shape=box];\n" ++ + " 1 -> 2;\n" ++ + " 1 -> 4;\n" ++ + " 2 -> 3;\n" ++ + " 2 -> 7;\n" ++ + " 3 -> 4;\n" ++ + " 3 -> 9;\n" ++ + " 4 -> 5;\n" ++ + " 4 -> 6;\n" ++ + " 5 -> 6;\n" ++ + " 7 -> 6;\n" ++ + " 7 -> 8;\n" ++ + " 9 -> 6;\n" ++ " 9 -> 10;\n" ++ " 10 -> 11;\n" ++ "}" diff --git a/test/Ethereum/AnalyzerSpec.hs b/test/Ethereum/AnalyzerSpec.hs new file mode 100644 --- /dev/null +++ b/test/Ethereum/AnalyzerSpec.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} + +module Ethereum.AnalyzerSpec + ( spec + ) where + +import Ethereum.Analyzer +import Blockchain.ExtWord +import Blockchain.VM.Opcodes +import Data.List as DL +import Data.List.Extra as DLE +import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord +import SpecCommon +import Test.Hspec + +spec :: Spec +spec = do + describe "decompile" $ + do it "works for hexcode1" $ + do let decompiled1 = show $ showOps $ decompileHexString hexcode1 + DL.take 60 decompiled1 `shouldBe` + "[\"0: PUSH [96]\",\"2: PUSH [64]\",\"4: MSTORE\",\"5: PUSH [2]\",\"7:" + DLE.takeEnd 60 decompiled1 `shouldBe` + "]\",\"6989: JUMP\",\"6990: JUMPDEST\",\"6991: SWAP1\",\"6992: JUMP\"]" + it "works for hexcode2" $ + do let decompiled2 = show $ showOps $ decompileHexString hexcode2 + decompiled2 `shouldBe` "[\"0: PUSH [96]\"," ++ + "\"2: PUSH [64]\"," ++ + "\"4: MSTORE\"," ++ + "\"5: CALLDATASIZE\"," ++ + "\"6: ISZERO\"," ++ + "\"7: PUSH [39]\"," ++ + "\"9: JUMPI\"," ++ + "\"10: PUSH [224]\"," ++ + "\"12: PUSH [2]\"," ++ + "\"14: EXP\"," ++ + "\"15: PUSH [0]\"," ++ + "\"17: CALLDATALOAD\"," ++ + "\"18: DIV\"," ++ + "\"19: PUSH [65,192,225,181]\"," ++ + "\"24: DUP2\"," ++ + "\"25: EQ\"," ++ + "\"26: PUSH [110]\"," ++ + "\"28: JUMPI\"," ++ + "\"29: DUP1\"," ++ + "\"30: PUSH [229,34,83,129]\"," ++ + "\"35: EQ\"," ++ + "\"36: PUSH [150]\"," ++ + "\"38: JUMPI\"," ++ + "\"39: JUMPDEST\"," ++ + "\"40: PUSH [213]\"," ++ + "\"42: PUSH [0]\"," ++ + "\"44: CALLVALUE\"," ++ + "\"45: GT\"," ++ + "\"46: ISZERO\"," ++ + "\"47: PUSH [108]\"," ++ + "\"49: JUMPI\"," ++ + "\"50: CALLVALUE\"," ++ + "\"51: PUSH [96]\"," ++ + "\"53: SWAP1\"," ++ + "\"54: DUP2\"," ++ + "\"55: MSTORE\"," ++ + "\"56: PUSH [88]\"," ++ + "\"58: SWAP1\"," ++ + "\"59: PUSH [1]\"," ++ + "\"61: PUSH [160]\"," ++ + "\"63: PUSH [2]\"," ++ + "\"65: EXP\"," ++ + "\"66: SUB\"," ++ + "\"67: CALLER\"," ++ + "\"68: AND\"," ++ + "\"69: SWAP1\"," ++ + "\"70: PUSH [144,137,8,9,198,84,241,29,110,114,162,143,166,1,73,119,10,13,17,236,108,146,49,157,108,235,43,176,164,234,26,21]\"," ++ + "\"103: SWAP1\"," ++ + "\"104: PUSH [32]\"," ++ + "\"106: SWAP1\"," ++ + "\"107: LOG3\"," ++ + "\"108: JUMPDEST\"," ++ + "\"109: JUMP\"," ++ + "\"110: JUMPDEST\"," ++ + "\"111: PUSH [213]\"," ++ + "\"113: PUSH [0]\"," ++ + "\"115: SLOAD\"," ++ + "\"116: PUSH [1]\"," ++ + "\"118: PUSH [160]\"," ++ + "\"120: PUSH [2]\"," ++ + "\"122: EXP\"," ++ + "\"123: SUB\"," ++ + "\"124: SWAP1\"," ++ + "\"125: DUP2\"," ++ + "\"126: AND\"," ++ + "\"127: CALLER\"," ++ + "\"128: SWAP2\"," ++ + "\"129: SWAP1\"," ++ + "\"130: SWAP2\"," ++ + "\"131: AND\"," ++ + "\"132: EQ\"," ++ + "\"133: ISZERO\"," ++ + "\"134: PUSH [108]\"," ++ + "\"136: JUMPI\"," ++ + "\"137: PUSH [0]\"," ++ + "\"139: SLOAD\"," ++ + "\"140: PUSH [1]\"," ++ + "\"142: PUSH [160]\"," ++ + "\"144: PUSH [2]\"," ++ + "\"146: EXP\"," ++ + "\"147: SUB\"," ++ + "\"148: AND\"," ++ + "\"149: SUICIDE\"," ++ + "\"150: JUMPDEST\"," ++ + "\"151: PUSH [213]\"," ++ + "\"153: PUSH [0]\"," ++ + "\"155: SLOAD\"," ++ + "\"156: PUSH [1]\"," ++ + "\"158: PUSH [160]\"," ++ + "\"160: PUSH [2]\"," ++ + "\"162: EXP\"," ++ + "\"163: SUB\"," ++ + "\"164: SWAP1\"," ++ + "\"165: DUP2\"," ++ + "\"166: AND\"," ++ + "\"167: CALLER\"," ++ + "\"168: SWAP2\"," ++ + "\"169: SWAP1\"," ++ + "\"170: SWAP2\"," ++ + "\"171: AND\"," ++ + "\"172: EQ\"," ++ + "\"173: ISZERO\"," ++ + "\"174: PUSH [108]\"," ++ + "\"176: JUMPI\"," ++ + "\"177: PUSH [0]\"," ++ + "\"179: DUP1\"," ++ + "\"180: SLOAD\"," ++ + "\"181: PUSH [1]\"," ++ + "\"183: PUSH [160]\"," ++ + "\"185: PUSH [2]\"," ++ + "\"187: EXP\"," ++ + "\"188: SUB\"," ++ + "\"189: SWAP1\"," ++ + "\"190: DUP2\"," ++ + "\"191: AND\"," ++ + "\"192: SWAP2\"," ++ + "\"193: SWAP1\"," ++ + "\"194: ADDRESS\"," ++ + "\"195: AND\"," ++ + "\"196: BALANCE\"," ++ + "\"197: PUSH [96]\"," ++ + "\"199: DUP3\"," ++ + "\"200: DUP2\"," ++ + "\"201: DUP2\"," ++ + "\"202: DUP2\"," ++ + "\"203: DUP6\"," ++ + "\"204: DUP9\"," ++ + "\"205: DUP4\"," ++ + "\"206: CALL\"," ++ + "\"207: POP\"," ++ + "\"208: POP\"," ++ + "\"209: POP\"," ++ + "\"210: POP\"," ++ + "\"211: POP\"," ++ + "\"212: JUMP\"," ++ "\"213: JUMPDEST\"," ++ "\"214: STOP\"]"