diff --git a/ethereum-analyzer.cabal b/ethereum-analyzer.cabal --- a/ethereum-analyzer.cabal +++ b/ethereum-analyzer.cabal @@ -1,5 +1,5 @@ name: ethereum-analyzer -version: 2.0.0 +version: 2.0.1 synopsis: A Ethereum contract analyzer. homepage: https://github.com/ethereumK/ethereum-analyzer license: Apache-2.0 @@ -21,7 +21,7 @@ source-repository this type: git location: https://github.com/zchn/ethereum-analyzer - tag: v2.0.0 + tag: v2.0.1 subdir: ethereum-analyzer library diff --git a/src/Ethereum/Analyzer/Solidity/AstJson.hs b/src/Ethereum/Analyzer/Solidity/AstJson.hs --- a/src/Ethereum/Analyzer/Solidity/AstJson.hs +++ b/src/Ethereum/Analyzer/Solidity/AstJson.hs @@ -7,7 +7,7 @@ , defSolNode ) where -import Protolude hiding (show) +import Protolude hiding (show, (<>)) import Data.Aeson import Data.Aeson.Types @@ -39,6 +39,7 @@ , _AST :: Maybe SolNode , attributes :: Maybe SolNode , constant :: Maybe Bool + , components :: Maybe [Maybe SolNode] , fullyImplemented :: Maybe Bool , hexvalue :: Maybe Text , isLibrary :: Maybe Bool @@ -59,11 +60,15 @@ instance ToJSON SolNode where toJSON = - genericToJSON defaultOptions {fieldLabelModifier = dropWhile (== '_')} + genericToJSON + defaultOptions + {fieldLabelModifier = dropWhile (== '_'), omitNothingFields = True} instance FromJSON SolNode where parseJSON = - genericParseJSON defaultOptions {fieldLabelModifier = dropWhile (== '_')} + genericParseJSON + defaultOptions + {fieldLabelModifier = dropWhile (== '_'), omitNothingFields = True} defSolNode :: SolNode defSolNode = @@ -74,6 +79,7 @@ , _AST = Nothing , attributes = Nothing , constant = Nothing + , components = Nothing , fullyImplemented = Nothing , hexvalue = Nothing , isLibrary = Nothing @@ -117,10 +123,7 @@ | name == Just "FunctionCall" = prettyFunctionCall n | name == Just "UserDefinedTypeName" = prettyUserDefinedTypeName n | name == Just "Literal" = prettyLiteral n - | otherwise = panic . toS $ "unimplemented: " <> showWithoutChildren n - -showWithoutChildren :: SolNode -> Text -showWithoutChildren n = toS $ show (n {children = Nothing}) + | otherwise = unimplementedPanic n prettyAst :: SolNode -> Doc prettyAst SolNode {name = Nothing, _AST = Just ast} = pretty ast diff --git a/src/Ethereum/Analyzer/Solidity/Finding.hs b/src/Ethereum/Analyzer/Solidity/Finding.hs --- a/src/Ethereum/Analyzer/Solidity/Finding.hs +++ b/src/Ethereum/Analyzer/Solidity/Finding.hs @@ -16,5 +16,5 @@ sdExp exp = case exp of ExpCall (JustId (Idfr "suicide")) _ -> - ["Prefer 'selfdestruct' than 'suicide'."] + ["Prefer 'selfdestruct' over 'suicide'."] _ -> [] diff --git a/src/Ethereum/Analyzer/Solidity/Foreach.hs b/src/Ethereum/Analyzer/Solidity/Foreach.hs --- a/src/Ethereum/Analyzer/Solidity/Foreach.hs +++ b/src/Ethereum/Analyzer/Solidity/Foreach.hs @@ -24,6 +24,7 @@ instance HasStatements Statement where _sOf s@(StIf _ thenSts elseSts) = [s] <> concatMap _sOf thenSts <> concatMap _sOf elseSts + _sOf s@(StLoop bodySts) = [s] <> concatMap _sOf bodySts _sOf s = [s] expressionsOf :: Contract -> [Expression] @@ -33,6 +34,9 @@ _eOf (StLocalVarDecl _) = [] _eOf (StAssign _ e) = [e] _eOf (StIf _ _ _) = [] +_eOf (StLoop _) = [] +_eOf StBreak = [] +_eOf StContinue = [] _eOf (StReturn _) = [] _eOf (StDelete _) = [] _eOf st@(StTodo _) = unimplementedPanic st diff --git a/src/Ethereum/Analyzer/Solidity/Simple.hs b/src/Ethereum/Analyzer/Solidity/Simple.hs --- a/src/Ethereum/Analyzer/Solidity/Simple.hs +++ b/src/Ethereum/Analyzer/Solidity/Simple.hs @@ -53,6 +53,7 @@ , iIndex :: LValue} | Member { mObj :: LValue , mField :: Idfr} + | Tuple [LValue] deriving (Eq, Generic, Show, GP.Out) data VarType @@ -78,6 +79,9 @@ | StIf LValue [Statement] [Statement] + | StLoop [Statement] + | StBreak + | StContinue | StReturn [LValue] | StDelete LValue | StTodo Text @@ -191,6 +195,17 @@ let newidfr = JustId $ Idfr newVar return [StAssign newidfr $ ExpLiteral "1", StAssign idfr $ ExpBin "+" idfr newidfr] +s2sStatements e@SolNode { name = Just "UnaryOperation" + , children = Just [SolNode { name = Just "Identifier" + , attributes = Just SolNode {value = Just idName} + }] + , attributes = Just SolNode {operator = Just "--"} + } = do + let idfr = JustId $ Idfr idName + newVar <- uniqueVar + let newidfr = JustId $ Idfr newVar + return + [StAssign newidfr $ ExpLiteral "1", StAssign idfr $ ExpBin "-" idfr newidfr] s2sStatements SolNode { name = Just "IfStatement" , children = Just [cond, thenBr] } = do @@ -204,6 +219,30 @@ thenSts <- s2sStatements thenBr elseSts <- s2sStatements elseBr return $ precond <> [StIf lvalcond thenSts elseSts] +s2sStatements SolNode { name = Just "WhileStatement" + , children = Just [cond, body] + } = do + (precond, lvalcond) <- s2sLval cond + bodySts <- s2sStatements body + return [StLoop (precond <> [StIf lvalcond bodySts [StBreak]])] +s2sStatements SolNode { name = Just "DoWhileStatement" + , children = Just [cond, body] + } = do + (precond, lvalcond) <- s2sLval cond + bodySts <- s2sStatements body + return [StLoop (bodySts <> precond <> [StIf lvalcond [StContinue] [StBreak]])] +s2sStatements SolNode { name = Just "ForStatement" + , children = Just [inits, cond, iters, body] + } = do + initSts <- s2sStatements inits + (precond, lvalcond) <- s2sLval cond + iterSts <- s2sStatements iters + bodySts <- s2sStatements body + return $ + initSts <> + [StLoop (precond <> [StIf lvalcond (bodySts <> iterSts) [StBreak]])] +s2sStatements SolNode {name = Just "Break"} = return [StBreak] +s2sStatements SolNode {name = Just "Continue"} = return [StContinue] s2sStatements SolNode { name = Just "VariableDeclarationStatement" , children = Just [vdec@SolNode {name = Just "VariableDeclaration"}, vinit] } = do @@ -272,10 +311,25 @@ ( preOp1 <> preOp2 <> [StAssign (JustId $ Idfr newVar) (ExpBin vOp lvalOp1 lvalOp2)] , JustId $ Idfr newVar) +s2sLval SolNode { name = Just "Conditional" + , children = Just [cond, opThen, opElse] + } = do + (preCond, lvalCond) <- s2sLval cond + (preOpThen, lvalOpThen) <- s2sLval opThen + (preOpElse, lvalOpElse) <- s2sLval opElse + opVar <- uniqueVar + return + ( preCond <> + [ StIf + lvalCond + (preOpThen <> [StAssign (JustId $ Idfr opVar) (ExpLval lvalOpThen)]) + (preOpElse <> [StAssign (JustId $ Idfr opVar) (ExpLval lvalOpElse)]) + ] + , JustId $ Idfr opVar) s2sLval SolNode {name = Just "FunctionCall", children = Just (func:params)} = do (preFun, lvalFun) <- s2sLval func preAndlvals <- mapM s2sLval params - let preArgs = concat (map fst preAndlvals) -- TODO(zchn): reverse? + let preArgs = concatMap fst preAndlvals -- TODO(zchn): reverse? let lvalArgs = map snd preAndlvals newVar <- uniqueVar return @@ -292,6 +346,21 @@ s2sLval SolNode { name = Just "ElementaryTypeNameExpression" , attributes = Just SolNode {value = Just v} } = return ([], JustId $ Idfr v) +-- For TupleExpression @ solc-0.4.11 +s2sLval SolNode {name = Just "TupleExpression", children = Just elems} = do + preAndlvals <- mapM s2sLval elems + let preArgs = concatMap fst preAndlvals -- TODO(zchn): reverse? + let lvalArgs = map snd preAndlvals + return (preArgs, Tuple lvalArgs) +-- For TupleExpression @ solc-0.4.17 +s2sLval SolNode { name = Just "TupleExpression" + , attributes = Just SolNode {components = Just maybeComps} + } = do + let comps = catMaybes maybeComps + preAndlvals <- mapM s2sLval comps + let preArgs = concatMap fst preAndlvals -- TODO(zchn): reverse? + let lvalArgs = map snd preAndlvals + return (preArgs, Tuple lvalArgs) s2sLval n = unimplementedPanic n {children = Nothing} uniqueVar