├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── cabal.project ├── solidity-cfg-builder.cabal └── src ├── CFG.hs ├── CFG ├── CFG.hs └── Parsing.hs └── Main.hs /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for solidity-cfg-builder 2 | 3 | ## 0.2 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, shaunazzopardi 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of shaunazzopardi nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # solidity-cfg-builder 2 | A control-flow graph builder for Solidity smart contracts. 3 | 4 | ## Overview 5 | 6 | This package generates a control-flow graph from Solidity contracts. Control-flow graphs are helpful as a graphic representation of the semantics of programs, and are the basis of many static analysis approaches to optimizing and verifying programs. This package is the basis of a static analysis approach I am currently developing. 7 | 8 | solidity-cfg-builder is developed in Haskell, utilising a Solidity syntax parser used in the runtime verification tool for Solidity [contractLarva](https://github.com/gordonpace/contractLarva). The version of the parser used in the project is packaged in the project. 9 | 10 | This tool given Solidity code generates a control-flow graph in DOT notation, which can be visualised using [GraphViz](https://www.graphviz.org/). 11 | 12 | ## Building the tool 13 | 14 | Requirements: [cabal v2.4.\*](https://www.haskell.org/cabal/) (e.g. install the full [Haskell Platform](https://www.haskell.org/platform/)) 15 | 16 | Compilation: Follow the instructions [here](https://cabal.readthedocs.io/en/latest/nix-local-build.html) 17 | 18 | ## Tool usage: 19 | 20 | For correct results always make sure that the Solidity code compiles with a Solidity compiler. 21 | 22 | To use the tool pass the location of a solidity file and the preferred location of the output to the executable, e.g. execute: 23 | 24 | > "./solidity-cfg-builder" <solidity-code.sol> <cfg.gv> 25 | 26 | ## License 27 | This project is licensed under the terms of the [Apache 2.0 license](LICENSE). 28 | 29 | ## TODO (See Issues for an up-to-date list) 30 | 1. Handle function modifiers 31 | 2. Allow option to flatten CFGs with function calls (consider also contract inheritance) 32 | 3. Handle block of statements at end of function definition 33 | 4. Event triggering is being parsed as a function call. Post-process to show triggerring of event explicitly. 34 | ---- 35 | # FAQ and Common Problems 36 | 37 | ### When compiling the code I get the error: Could not find module ‘Text.Parsec’. 38 | Make sure you have installed parsec. Also, see this stackoverflow thread (https://stackoverflow.com/questions/9058914/cant-find-parsec-modules-in-ghci) 39 | >cabal install parsec 40 | 41 | 42 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | source-repository-package 2 | type: git 3 | location: git://github.com/shaunazzopardi/contractlarva.git 4 | subdir: ./ 5 | 6 | packages: ./solidity-cfg-builder.cabal -------------------------------------------------------------------------------- /solidity-cfg-builder.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | 3 | -- Initial solidity-cfg-builder.cabal generated by cabal init. For further 4 | -- documentation, see http://haskell.org/cabal/users-guide/ 5 | 6 | -- The name of the package. 7 | name: solidity-cfg-builder 8 | 9 | -- The package version. See the Haskell package versioning policy (PVP) 10 | -- for standards guiding when and how versions should be incremented. 11 | -- https://wiki.haskell.org/Package_versioning_policy 12 | -- PVP summary: +-+------- breaking API changes 13 | -- | | +----- non-breaking API additions 14 | -- | | | +--- code changes with no API change 15 | version: 0.2 16 | 17 | -- A short (one-line) description of the package. 18 | synopsis: A control-flow graph builder for Solidity smart contracts. 19 | 20 | -- A longer description of the package. 21 | -- description: 22 | 23 | -- URL for the project homepage or repository. 24 | homepage: https://github.com/shaunazzopardi/solidity-cfg-builder 25 | 26 | -- The license under which the package is released. 27 | license: BSD-3-Clause 28 | 29 | -- The file containing the license text. 30 | license-file: LICENSE 31 | 32 | -- The package author(s). 33 | author: shaunazzopardi 34 | 35 | -- An email address to which users can send suggestions, bug reports, and 36 | -- patches. 37 | maintainer: shaun.azzopardi@gmail.com 38 | 39 | -- A copyright notice. 40 | -- copyright: 41 | 42 | category: Analysis 43 | 44 | build-type: Simple 45 | 46 | -- Extra files to be distributed with the package, such as examples or a 47 | -- README. 48 | extra-source-files: ChangeLog.md, README.md 49 | 50 | library 51 | exposed-modules: Main, CFG, CFG.Parsing, CFG.CFG 52 | -- other-modules: 53 | other-extensions: FlexibleContexts 54 | build-depends: base ^>=4.12.0.0, parsec >=3.1 && <3.2, parsec3-numbers >=0.1 && <0.2, contractLarva 55 | hs-source-dirs: src 56 | default-language: Haskell2010 57 | 58 | 59 | executable solidity-cfg-builder 60 | -- .hs or .lhs file containing the Main module. 61 | main-is: Main.hs 62 | 63 | -- Modules included in this executable, other than Main. 64 | other-modules: CFG 65 | CFG.CFG 66 | CFG.Parsing 67 | 68 | -- LANGUAGE extensions used by modules in this package. 69 | other-extensions: FlexibleContexts 70 | 71 | -- Other library packages from which modules are imported. 72 | build-depends: base ^>=4.12.0.0, parsec >=3.1 && <3.2, parsec3-numbers >=0.1 && <0.2, contractLarva 73 | 74 | -- Directories containing source files. 75 | hs-source-dirs: src 76 | 77 | -- Base language which the package is written in. 78 | default-language: Haskell2010 -------------------------------------------------------------------------------- /src/CFG.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Licensed under the Apache License, Version 2.0 (the "License"); 3 | -- you may not use this file except in compliance with the License. 4 | -- You may obtain a copy of the License at 5 | -- 6 | -- http://www.apache.org/licenses/LICENSE-2.0 7 | -- 8 | -- Unless required by applicable law or agreed to in writing, software 9 | -- distributed under the License is distributed on an "AS IS" BASIS, 10 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 11 | -- See the License for the specific language governing permissions and 12 | -- limitations under the License. 13 | 14 | module CFG (module CFG.CFG, module CFG.Parsing) where 15 | 16 | import CFG.CFG 17 | import CFG.Parsing 18 | -------------------------------------------------------------------------------- /src/CFG/CFG.hs: -------------------------------------------------------------------------------- 1 | module CFG.CFG (State(..), Condition(..), Transition(..), FunctionCFG(..), CFG(..), FunctionCall(..), isFunctionCallState, contractCFG, contractCFGFromContractDefinition, FunctionVisibility(..), FunctionSignature(..), prependStatementLabelsWith) where 2 | 3 | import Solidity.Solidity 4 | import Data.List 5 | import Debug.Trace 6 | 7 | --TODO allow intermediate expression states to be ignored 8 | --TODO turn ternary conditional operator to be turned into if-then-else statement 9 | 10 | type SCAddress = String 11 | 12 | data State = BasicState { 13 | label :: String 14 | } 15 | | StatementState { 16 | label :: String, 17 | stmt :: Statement 18 | } 19 | | ExpressionState { 20 | label :: String, 21 | expr :: Expression 22 | } 23 | | ThrowState 24 | | RevertState 25 | | ReturnState 26 | | FunctionCallState { 27 | label :: String, 28 | functionCall :: FunctionCall 29 | } 30 | -- | ExternalFunctionCallState { 31 | -- label :: String, 32 | -- functionCall :: FunctionCall 33 | --} 34 | deriving (Eq, Ord, Show) 35 | 36 | 37 | data Condition = ConditionHolds Expression | ConditionDoesNotHold Expression | TT | FF deriving (Eq, Ord, Show) 38 | 39 | data FunctionCall = FunctionCall FunctionName (Maybe (Either NameValueList ExpressionList)) 40 | | OutsideFunctionCall (Maybe Expression) FunctionName (Maybe (Either NameValueList ExpressionList)) deriving (Eq, Ord, Show) 41 | 42 | data FunctionVisibility = Public | Private | FInternal | FExternal deriving (Eq, Ord, Show) 43 | 44 | data FunctionSignature = FunctionSignature{ 45 | functionName :: Identifier, 46 | functionVisibility :: Maybe FunctionVisibility, 47 | parameters :: ParameterList, 48 | returnParams :: ParameterList 49 | } deriving (Eq, Ord, Show) 50 | 51 | data Transition = 52 | Transition { 53 | src, dst :: State, 54 | condition :: Condition 55 | } deriving (Eq, Ord, Show) 56 | 57 | --add possibility that control-flow is unknown 58 | data FunctionCFG = FunctionCFG{ 59 | signature :: FunctionSignature, 60 | transitions :: [Transition], 61 | states :: [State], 62 | initial :: State, 63 | end :: [State] 64 | } deriving (Eq, Ord, Show) 65 | 66 | data CFG = CFG [FunctionCFG] 67 | 68 | --data SequenceFunctionCFGs = SequenceFunctionCFGs{ 69 | -- cfgs :: [FunctionCFG], 70 | -- callingTransitions = [Transition] 71 | --} 72 | 73 | 74 | 75 | contractCFG :: SolidityCode -> CFG 76 | contractCFG (SolidityCode (SourceUnit sourceUnits)) = 77 | let functionCFGs = map (contractCFGFromSource) sourceUnits 78 | functionCFGsFlattened = foldr (++) [] functionCFGs 79 | in CFG functionCFGsFlattened 80 | 81 | -------------------------------------------------------------- 82 | -------------------------------------------------------------- 83 | 84 | contractCFGFromSource :: SourceUnit1 -> [FunctionCFG] 85 | contractCFGFromSource (SourceUnit1_ContractDefinition contractDefinition) = contractCFGFromContractDefinition contractDefinition 86 | contractCFGFromSource _ = [] 87 | -------------------------------------------------------------- 88 | -------------------------------------------------------------- 89 | 90 | contractCFGFromContractDefinition :: ContractDefinition -> [FunctionCFG] 91 | contractCFGFromContractDefinition contractDefinition = 92 | let contractPartss = contractParts contractDefinition 93 | modifierCFGs = justifyList (map (parseModifierCFG) contractPartss) 94 | properFunctionsCFGs = justifyList (map (parseFunctionCFG modifierCFGs) contractPartss) 95 | withProperAssertAndRequires = map (handleAssertAndRequires properFunctionsCFGs) properFunctionsCFGs 96 | in map addEndStates (map (handleFalseFunctionCalls withProperAssertAndRequires) withProperAssertAndRequires) 97 | -------------------------------------------------------------- 98 | -------------------------------------------------------------- 99 | --check that if it is a local function call, but there is no local function with that name then treat it as an outside function call state, for soundness 100 | -- e.g. creating a new smart contract will be parsed as a local function call naively, but it executes the constructor at a certain address, i.e. it calls an outside function. 101 | --TODO handle send and transfer 102 | 103 | handleFalseFunctionCalls :: [FunctionCFG] -> FunctionCFG -> FunctionCFG 104 | handleFalseFunctionCalls [] cfg = cfg 105 | handleFalseFunctionCalls cfgs cfg = handleFalseFunctionCallsStates (states cfg) cfgs cfg 106 | 107 | handleFalseFunctionCallsStates :: [State] -> [FunctionCFG] -> FunctionCFG -> FunctionCFG 108 | handleFalseFunctionCallsStates [] _ cfg = cfg 109 | handleFalseFunctionCallsStates ((FunctionCallState l (FunctionCall name (Just (Left nvl)))):sts) cfgs cfg 110 | = let newCFG = if (null [fcg | fcg <- cfgs, name == functionName (signature fcg)]) 111 | then let newState = (StatementState l (SimpleStatementExpression (FunctionCallNameValueList (Literal (PrimaryExpressionIdentifier name)) (Just nvl)))) 112 | oldState = (FunctionCallState l (FunctionCall name (Just (Left nvl)))) 113 | in replaceStateWithState cfg oldState newState 114 | else cfg 115 | in handleFalseFunctionCallsStates sts cfgs newCFG 116 | 117 | handleFalseFunctionCallsStates ((FunctionCallState l (FunctionCall name (Just (Right expl)))):sts) cfgs cfg 118 | = let newCFG = if (null [fcg | fcg <- cfgs, name == functionName (signature fcg)]) 119 | then let newState = (StatementState l (SimpleStatementExpression (FunctionCallExpressionList (Literal (PrimaryExpressionIdentifier name)) (Just expl)))) 120 | oldState = (FunctionCallState l (FunctionCall name (Just (Right expl)))) 121 | in replaceStateWithState cfg oldState newState 122 | else cfg 123 | in handleFalseFunctionCallsStates sts cfgs newCFG 124 | 125 | --cfgStepWithExpression (FunctionCallNameValueList (MemberAccess expression functionName) (Just (NameValueList nameValueList))) cfg state = 126 | -- let expressions = map (snd) nameValueList 127 | -- (newCFG, newState) = cfgStepWithExpressions expressions cfg state 128 | -- functionCall = OutsideFunctionCall (Just expression) functionName (Just (Left (NameValueList nameValueList))) 129 | -- in addFunctionTransition functionCall newCFG newState 130 | 131 | 132 | handleFalseFunctionCallsStates ((FunctionCallState l (OutsideFunctionCall (Just expression) name (Just (Left (NameValueList nameValueList))))):sts) cfgs cfg 133 | = let newCFG = if ((name == Identifier "transfer" || name == Identifier "send" || name == Identifier "call" || name == Identifier "delegateCall") 134 | && null [fcg | fcg <- cfgs, name == functionName (signature fcg)]) 135 | then let newState = (StatementState l (SimpleStatementExpression (FunctionCallNameValueList (MemberAccess expression name) (Just (NameValueList nameValueList))))) 136 | oldState = (FunctionCallState l (OutsideFunctionCall (Just expression) name (Just (Left (NameValueList nameValueList))))) 137 | in replaceStateWithState cfg oldState newState 138 | else cfg 139 | in handleFalseFunctionCallsStates sts cfgs newCFG 140 | 141 | 142 | handleFalseFunctionCallsStates ((FunctionCallState l (OutsideFunctionCall (Just expression) name (Just (Right (ExpressionList exprList))))):sts) cfgs cfg 143 | = let newCFG = if ((name == Identifier "transfer" || name == Identifier "send" || name == Identifier "call" || name == Identifier "delegateCall") 144 | && null [fcg | fcg <- cfgs, name == functionName (signature fcg)]) 145 | then let newState = (StatementState l (SimpleStatementExpression (FunctionCallExpressionList (MemberAccess expression name) (Just (ExpressionList exprList))))) 146 | oldState = (FunctionCallState l (OutsideFunctionCall (Just expression) name (Just (Right (ExpressionList exprList))))) 147 | in replaceStateWithState cfg oldState newState 148 | else cfg 149 | in handleFalseFunctionCallsStates sts cfgs newCFG 150 | 151 | handleFalseFunctionCallsStates (s:sts) cfgs cfg = handleFalseFunctionCallsStates sts cfgs cfg 152 | 153 | ------------------------------------ 154 | ------------------------------------ 155 | 156 | justifyList :: [Maybe FunctionCFG] -> [FunctionCFG] 157 | justifyList [] = [] 158 | justifyList ((Just functionCFG):rest) = functionCFG:(justifyList rest) 159 | justifyList ((Nothing):rest) = justifyList rest 160 | 161 | -------------------------------------------------------------- 162 | -------------------------------------------------------------- 163 | 164 | functionDefinitionTagsToFunctionVisibility :: [FunctionDefinitionTag] -> FunctionVisibility 165 | functionDefinitionTagsToFunctionVisibility [] = Public 166 | functionDefinitionTagsToFunctionVisibility (FunctionDefinitionTagPublic:_) = Public 167 | functionDefinitionTagsToFunctionVisibility (FunctionDefinitionTagPrivate:_) = Private 168 | functionDefinitionTagsToFunctionVisibility (FunctionDefinitionTagStateMutability Internal:_) = FInternal 169 | functionDefinitionTagsToFunctionVisibility (FunctionDefinitionTagStateMutability External:_) = FExternal 170 | functionDefinitionTagsToFunctionVisibility (_:rest) = functionDefinitionTagsToFunctionVisibility rest 171 | 172 | -------------------------------------------------------------- 173 | -------------------------------------------------------------- 174 | 175 | parseFunctionCFG :: [FunctionCFG] -> ContractPart -> Maybe FunctionCFG 176 | --TODO handle input parameters 177 | parseFunctionCFG modifierCFGs (ContractPartFunctionDefinition (Just id) params functionDefinitionTags return (Just block)) = 178 | let sign = FunctionSignature{ 179 | functionName = id, 180 | functionVisibility = Just (functionDefinitionTagsToFunctionVisibility functionDefinitionTags), 181 | parameters = params, 182 | returnParams = case return of 183 | Nothing -> ParameterList [] 184 | Just par -> par 185 | } 186 | initState = BasicState (show 0) 187 | cfg = FunctionCFG{ 188 | signature = sign, 189 | transitions = [], 190 | states = [initState], 191 | initial = initState, 192 | end = [] 193 | } 194 | (newCFG, state) = (cfgStepWithStatement (BlockStatement block) cfg (initial cfg)) 195 | finalCFG = newCFG--(addEndState newCFG state) 196 | relevantModifierCFGs = respectiveModifierCFGs functionDefinitionTags modifierCFGs 197 | in Just (addModifiersControlFlow finalCFG relevantModifierCFGs) 198 | 199 | 200 | parseFunctionCFG modifierCFGs (ContractPartFunctionDefinition (Nothing) _ _ (_) (Just block)) = 201 | let sign = FunctionSignature{ 202 | functionName = Identifier "", 203 | functionVisibility = Just Public, 204 | parameters = ParameterList [], 205 | returnParams = ParameterList [] 206 | } 207 | initState = BasicState (show 0) 208 | cfg = FunctionCFG{ 209 | signature = sign, 210 | transitions = [], 211 | states = [initState], 212 | initial = initState, 213 | end = [initState] 214 | } 215 | --(newCFG, state) = (cfgStepWithStatement (BlockStatement block) cfg (initial cfg)) 216 | --finalCFG = (addEndState newCFG state) 217 | --relevantModifierCFGs = respectiveModifierCFGs functionDefinitionTags modifierCFGs 218 | in Just cfg--Just (addModifiersControlFlow finalCFG relevantModifierCFGs) 219 | 220 | 221 | parseFunctionCFG _ _ = Nothing 222 | 223 | -------------------------------------------------------------- 224 | -------------------------------------------------------------- 225 | 226 | addEndStates :: FunctionCFG -> FunctionCFG 227 | addEndStates fcfg = FunctionCFG{ 228 | signature = signature fcfg, 229 | transitions = transitions fcfg ++ [Transition s ReturnState TT | s <- states fcfg, s /= ThrowState, s /= RevertState, s /= ReturnState, hasNoOutgoingTransitions s fcfg], 230 | states = states fcfg ++ [ReturnState], 231 | initial = initial fcfg, 232 | end = (end fcfg) ++ [ReturnState] ++ [RevertState | RevertState <- (states fcfg)] ++ [ThrowState | ThrowState <- (states fcfg)] 233 | } 234 | 235 | -------------------------------------------------------------- 236 | -------------------------------------------------------------- 237 | 238 | hasNoOutgoingTransitions :: State -> FunctionCFG -> Bool 239 | hasNoOutgoingTransitions s fcfg = [] == [t | t <- transitions fcfg, src t == s] 240 | 241 | -------------------------------------------------------------- 242 | -------------------------------------------------------------- 243 | 244 | parseModifierCFG (ContractPartModifierDefinition modifierName maybeParameterList block) = 245 | let initState = BasicState (show 0) 246 | cfg = FunctionCFG{ 247 | signature = FunctionSignature{ 248 | functionName = modifierName, 249 | functionVisibility = Nothing, 250 | parameters = case maybeParameterList of 251 | Nothing -> ParameterList [] 252 | Just params -> params, 253 | returnParams = ParameterList [] 254 | }, 255 | transitions = [], 256 | states = [initState], 257 | initial = initState, 258 | end = [] 259 | } 260 | (newCFG, state) = (cfgStepWithStatement (BlockStatement block) cfg (initial cfg)) 261 | in Just newCFG --(addEndState newCFG state) 262 | 263 | parseModifierCFG _ = Nothing 264 | 265 | -------------------------------------------------------------- 266 | -------------------------------------------------------------- 267 | --FunctionDefinitionTagModifierInvocation ModifierInvocation 268 | --data ModifierInvocation = 269 | -- ModifierInvocation { 270 | -- modifierInvocationIdentifier :: Identifier, 271 | -- modifierInvocationParameters :: Maybe ExpressionList 272 | -- } deriving (Show, Eq, Ord) 273 | 274 | respectiveModifierCFGs :: [FunctionDefinitionTag] -> [FunctionCFG] -> [FunctionCFG] 275 | respectiveModifierCFGs _ [] = [] 276 | respectiveModifierCFGs [] _ = [] 277 | respectiveModifierCFGs ftags cfgs = [c | c <- cfgs, (FunctionDefinitionTagModifierInvocation (ModifierInvocation id maybeParameters)) <- ftags, id == functionName (signature c)] 278 | 279 | -------------------------------------------------------------- 280 | -------------------------------------------------------------- 281 | 282 | addModifiersControlFlow :: FunctionCFG -> [FunctionCFG] -> FunctionCFG 283 | addModifiersControlFlow functionCFG [] = functionCFG 284 | addModifiersControlFlow functionCFG (m:modifierCFGs) = let modifiedCFG = addModifierControlFlow (functionName (signature m)) functionCFG m 285 | in addModifiersControlFlow modifiedCFG modifierCFGs 286 | -------------------------------------------------------------- 287 | -------------------------------------------------------------- 288 | 289 | isPlaceholder :: State -> Bool 290 | isPlaceholder (StatementState _ PlaceholderStatement) = True 291 | isPlaceholder _ = False 292 | 293 | addModifierControlFlow :: Identifier -> FunctionCFG -> FunctionCFG -> FunctionCFG 294 | addModifierControlFlow (Identifier modifierName) functionCFG modifierCFG = let placeholderStates = [dst t | t <- transitions modifierCFG, isPlaceholder (src t)] 295 | in addModifierControlFlowAtTransitions modifierName 0 placeholderStates functionCFG modifierCFG 296 | 297 | 298 | 299 | addModifierControlFlowAtTransitions :: String -> Int -> [State] -> FunctionCFG -> FunctionCFG -> FunctionCFG 300 | addModifierControlFlowAtTransitions modifierName prefix [] functionCFG modifierCFG = functionCFG 301 | addModifierControlFlowAtTransitions modifierName prefix [s] functionCFG modifierCFG = addModifierControlFlowAtTransition (modifierName ++ show prefix) s functionCFG modifierCFG 302 | addModifierControlFlowAtTransitions modifierName prefix (s:placeholderStates) functionCFG modifierCFG = 303 | let cfg = addModifierControlFlowAtTransition (modifierName ++ (show (prefix))) s functionCFG modifierCFG 304 | in addModifierControlFlowAtTransitions modifierName (prefix + 1) (placeholderStates) functionCFG cfg 305 | 306 | -------------------------------------------------------------- 307 | -------------------------------------------------------------- 308 | 309 | addModifierControlFlowAtTransition :: String -> State -> FunctionCFG -> FunctionCFG -> FunctionCFG 310 | addModifierControlFlowAtTransition prefix placeholderState functionCFG modifierCFG = 311 | let prependedCFG = prependStatementLabelsWith prefix functionCFG 312 | in replaceStateWithCFG modifierCFG placeholderState prependedCFG 313 | -- in FunctionCFG{ 314 | -- signature = signature functionCFG, 315 | -- transitions = ((transitions modifierCFG) \\ [(Transition from to (Condition PlaceholderStatement))]) 316 | -- ++ (transitions prependedCFG) 317 | -- ++ [(Transition from (initial prependedCFG) TT)] 318 | -- ++ [(Transition source to TT) | source <- (end prependedCFG)], 319 | -- states = (states modifierCFG) ++ (states prependedCFG), 320 | -- initial = initial modifierCFG, 321 | -- end = end modifierCFG 322 | -- } 323 | 324 | -------------------------------------------------------------- 325 | -------------------------------------------------------------- 326 | 327 | prependStatementLabelsWith :: String -> FunctionCFG -> FunctionCFG 328 | prependStatementLabelsWith prefix functionCFG = FunctionCFG{ 329 | signature = signature functionCFG, 330 | transitions = [(Transition (prependStatementLabelWith prefix source) (prependStatementLabelWith prefix dest) ev) | Transition source dest ev <- transitions functionCFG], 331 | states = [prependStatementLabelWith prefix state | state <- states functionCFG], 332 | initial = prependStatementLabelWith prefix (initial functionCFG), 333 | end = [prependStatementLabelWith prefix state | state <- end functionCFG] 334 | } 335 | -------------------------------------------------------------- 336 | -------------------------------------------------------------- 337 | 338 | prependStatementLabelWith :: String -> State -> State 339 | prependStatementLabelWith prefix (BasicState label) = BasicState (prefix ++ label) 340 | prependStatementLabelWith prefix (FunctionCallState label functionName) = FunctionCallState (prefix ++ label) functionName 341 | prependStatementLabelWith _ s = s 342 | -------------------------------------------------------------- 343 | -------------------------------------------------------------- 344 | noStateChange (FunctionDefinitionTagStateMutability Pure) = True; 345 | noStateChange (FunctionDefinitionTagStateMutability Constant) = True; 346 | noStateChange (FunctionDefinitionTagStateMutability View) = True; 347 | noStateChange _ = False; 348 | 349 | -------------------------------------------------------------- 350 | -------------------------------------------------------------- 351 | --cfgFromFunction(Solidity.ContractPartFunctionDefinition identifier (ParameterList parameters) [FunctionDefinitionTag] _ (Just (Block statements))) = 352 | 353 | -------------------------------------------------------------- 354 | -------------------------------------------------------------- 355 | 356 | addTransition :: FunctionCFG -> Transition -> FunctionCFG 357 | addTransition cfg transition = FunctionCFG { 358 | signature = signature cfg, 359 | transitions = (transitions cfg) ++ [transition], 360 | states = states cfg, 361 | initial = initial cfg, 362 | end = end cfg 363 | } 364 | 365 | -------------------------------------------------------------- 366 | -------------------------------------------------------------- 367 | 368 | addTransitions :: FunctionCFG -> [Transition] -> FunctionCFG 369 | addTransitions cfg trs = FunctionCFG { 370 | signature = signature cfg, 371 | transitions = (transitions cfg) ++ trs, 372 | states = states cfg, 373 | initial = initial cfg, 374 | end = end cfg 375 | } 376 | 377 | -------------------------------------------------------------- 378 | -------------------------------------------------------------- 379 | 380 | addState :: FunctionCFG -> State -> FunctionCFG 381 | addState cfg state = let oldStates = states cfg 382 | in FunctionCFG { 383 | signature = signature cfg, 384 | transitions = transitions cfg, 385 | states = oldStates ++ [state], 386 | initial = initial cfg, 387 | end = end cfg 388 | } 389 | 390 | 391 | 392 | -------------------------------------------------------------- 393 | -------------------------------------------------------------- 394 | 395 | addStates :: FunctionCFG -> [State] -> FunctionCFG 396 | addStates cfg sts = let oldStates = states cfg 397 | in FunctionCFG { 398 | signature = signature cfg, 399 | transitions = transitions cfg, 400 | states = oldStates ++ sts, 401 | initial = initial cfg, 402 | end = end cfg 403 | } 404 | 405 | 406 | 407 | 408 | -------------------------------------------------------------- 409 | -------------------------------------------------------------- 410 | 411 | addEndState :: FunctionCFG -> State -> FunctionCFG 412 | addEndState cfg state = FunctionCFG { 413 | signature = signature cfg, 414 | transitions = transitions cfg, 415 | states = states cfg, 416 | initial = initial cfg, 417 | end = (end cfg) ++ [state] 418 | } 419 | 420 | -------------------------------------------------------------- 421 | -------------------------------------------------------------- 422 | 423 | nextLabel :: FunctionCFG -> String 424 | nextLabel cfg = show (length (states cfg)) 425 | 426 | -------------------------------------------------------------- 427 | -------------------------------------------------------------- 428 | 429 | currentLabel :: FunctionCFG -> String 430 | currentLabel cfg = show ((length (states cfg)) - 1) 431 | -------------------------------------------------------------- 432 | -------------------------------------------------------------- 433 | 434 | --Always add state to cfg in function that constructs the state 435 | 436 | cfgStepWithExpressions :: [Expression] -> FunctionCFG -> State -> (FunctionCFG, State) 437 | cfgStepWithExpressions [] cfg state = (cfg, state) 438 | cfgStepWithExpressions (e:exps) cfg state = let (newCFG, newState) = cfgStepWithExpression e cfg state 439 | in cfgStepWithExpressions exps newCFG newState 440 | 441 | -------------------------------------------------------------- 442 | -------------------------------------------------------------- 443 | 444 | cfgStepWithExpression :: Expression -> FunctionCFG -> State -> (FunctionCFG, State) 445 | cfgStepWithExpression (Unary string expression) cfg state = 446 | let expr = (Unary string expression) 447 | (newCFG, newState) = cfgStepWithExpression expression cfg state 448 | transition = Transition{src = newState, dst = ExpressionState (nextLabel newCFG) expr, condition = TT} 449 | cfgWithTransition = addTransition (addState newCFG (dst transition)) transition 450 | in (cfgWithTransition, dst transition) 451 | 452 | 453 | cfgStepWithExpression (Binary "=" expression1 expression2) cfg state = 454 | let expr = Binary "=" expression1 expression2 455 | (newCFG, newState) = cfgStepWithExpression expression2 cfg state 456 | transition = Transition{src = newState, dst = ExpressionState (nextLabel newCFG) expr, condition = TT} 457 | cfgWithTransition = addTransition (addState newCFG (dst transition)) transition 458 | in (cfgWithTransition, dst transition) 459 | 460 | cfgStepWithExpression (Binary string expression1 expression2) cfg state = 461 | let expr = Binary string expression1 expression2 462 | (newCFG1, newState1) = cfgStepWithExpression expression1 cfg state 463 | (newCFG, newState) = cfgStepWithExpression expression2 newCFG1 newState1 464 | transition = Transition{src = newState, dst = ExpressionState (nextLabel newCFG) expr, condition = TT} 465 | cfgWithTransition = addTransition (addState newCFG (dst transition)) transition 466 | in (cfgWithTransition, dst transition) 467 | 468 | cfgStepWithExpression (Ternary string expression1 expression2 expression3) cfg state = 469 | let expr = (Ternary string expression1 expression2 expression3) 470 | (newCFG1, newState1) = cfgStepWithExpression expression1 cfg state 471 | (newCFG2, newState2) = cfgStepWithExpression expression2 newCFG1 newState1 472 | (newCFG, newState) = cfgStepWithExpression expression3 newCFG2 newState2 473 | transition = Transition{src = newState, dst = ExpressionState (nextLabel newCFG) expr, condition = TT} 474 | cfgWithTransition = addTransition (addState newCFG (dst transition)) transition 475 | in (cfgWithTransition, dst transition) 476 | 477 | 478 | -- (FunctionCallNameValueList (Literal (PrimaryExpressionStringLiteral (StringLiteral functionName))) _) cfg state = addFunctionTransition (Identifier {unIdentifier = functionName}) cfg 479 | 480 | 481 | cfgStepWithExpression (FunctionCallNameValueList (Literal (PrimaryExpressionIdentifier functionName)) (Just (NameValueList nameValueList))) cfg state = 482 | let expressions = map (snd) nameValueList 483 | (newCFG, newState) = cfgStepWithExpressions expressions cfg state 484 | functionCall = FunctionCall functionName (Just (Left (NameValueList nameValueList))) 485 | in addFunctionTransition functionCall newCFG newState 486 | 487 | cfgStepWithExpression (FunctionCallNameValueList (Literal (PrimaryExpressionIdentifier functionName)) (Nothing)) cfg state = 488 | let functionCall = FunctionCall functionName Nothing 489 | in addFunctionTransition (functionCall) cfg state 490 | 491 | cfgStepWithExpression (FunctionCallNameValueList (MemberAccess expression functionName) (Just (NameValueList nameValueList))) cfg state = 492 | let expressions = map (snd) nameValueList 493 | (newCFG, newState) = cfgStepWithExpressions expressions cfg state 494 | functionCall = OutsideFunctionCall (Just expression) functionName (Just (Left (NameValueList nameValueList))) 495 | in addFunctionTransition functionCall newCFG newState 496 | 497 | 498 | cfgStepWithExpression (FunctionCallNameValueList (MemberAccess expression functionName) (Nothing)) cfg state = 499 | let functionCall = OutsideFunctionCall (Just expression) functionName Nothing 500 | in addFunctionTransition (functionCall) cfg state 501 | 502 | --add transitions for each expression in name value list 503 | 504 | 505 | cfgStepWithExpression (FunctionCallExpressionList (Literal (PrimaryExpressionIdentifier functionName)) Nothing) cfg state = 506 | let functionCall = FunctionCall functionName Nothing 507 | in addFunctionTransition (functionCall) cfg state 508 | 509 | cfgStepWithExpression (FunctionCallExpressionList (Literal (PrimaryExpressionIdentifier functionName)) (Just expressionList)) cfg state = 510 | let rawExpressionList = unExpressionList expressionList 511 | (cfgWithList, stateAfterList) = cfgStepWithExpressions rawExpressionList cfg state 512 | functionCall = FunctionCall functionName (Just (Right expressionList)) 513 | in addFunctionTransition (functionCall) cfgWithList stateAfterList 514 | 515 | 516 | cfgStepWithExpression (FunctionCallExpressionList (MemberAccess expression functionName) Nothing) cfg state = 517 | let (newCFG, newState) = cfgStepWithExpression expression cfg state 518 | functionCall = OutsideFunctionCall (Just expression) functionName (Nothing) 519 | in addFunctionTransition functionCall newCFG newState 520 | 521 | 522 | cfgStepWithExpression (FunctionCallExpressionList (MemberAccess expression functionName) (Just expressionList)) cfg state = 523 | let (newCFG, newState) = cfgStepWithExpression expression cfg state 524 | rawExpressionList = unExpressionList expressionList 525 | (cfgWithList, stateAfterList) = cfgStepWithExpressions rawExpressionList newCFG newState 526 | functionCall = OutsideFunctionCall (Just expression) functionName (Just (Right expressionList)) 527 | in addFunctionTransition (functionCall) cfgWithList stateAfterList 528 | 529 | 530 | -- Literal primaryExpression 531 | -- New TypeName 532 | cfgStepWithExpression expression cfg state = (cfg, state) 533 | 534 | -------------------------------------------------------------- 535 | -------------------------------------------------------------- 536 | 537 | addFunctionTransition :: FunctionCall -> FunctionCFG -> State -> (FunctionCFG, State) 538 | addFunctionTransition (FunctionCall functionName maybeParameters) cfg state = 539 | let entryTransition = Transition{src = state, dst = FunctionCallState{label = nextLabel cfg, functionCall = (FunctionCall functionName maybeParameters)}, condition = TT} 540 | cfgWithEntryTransition = (addState (addTransition cfg entryTransition) (dst entryTransition)) 541 | -- exitTransition = Transition{src = dst entryTransition, dst = BasicState{label = nextLabel cfgWithEntryTransition}, condition = Exiting (FunctionCall functionName maybeParameters)} 542 | -- cfgWithExitTransition = addState (addState (addTransition cfgWithEntryTransition exitTransition) (dst entryTransition)) (dst exitTransition) 543 | in (cfgWithEntryTransition, dst entryTransition) 544 | 545 | --OutsideFunctionCall (Just expression) FunctionName (Maybe (Either NameValueList ExpressionList)) 546 | 547 | addFunctionTransition (OutsideFunctionCall (Just expr) functionName maybeParameters) cfg state = 548 | let entryTransition = Transition{src = state, dst = FunctionCallState{label = nextLabel cfg, functionCall = (OutsideFunctionCall (Just expr) functionName maybeParameters)}, condition = TT} 549 | cfgWithEntryTransition = (addState (addTransition cfg entryTransition) (dst entryTransition)) 550 | -- exitTransition = Transition{src = dst entryTransition, dst = BasicState{label = nextLabel cfgWithEntryTransition}, condition = Exiting (OutsideFunctionCall expr functionName maybeParameters)} 551 | -- cfgWithExitTransition = addState (addState (addTransition cfgWithEntryTransition exitTransition) (dst entryTransition)) (dst exitTransition) 552 | in (cfgWithEntryTransition, dst entryTransition) 553 | 554 | 555 | -------------------------------------------------------------- 556 | -------------------------------------------------------------- 557 | 558 | cfgStepWithMaybeExpression :: Maybe Expression -> FunctionCFG -> State -> (FunctionCFG, State) 559 | cfgStepWithMaybeExpression Nothing cfg state = (cfg, state) 560 | cfgStepWithMaybeExpression (Just expression) cfg state = cfgStepWithExpression expression cfg state 561 | 562 | -------------------------------------------------------------- 563 | -------------------------------------------------------------- 564 | 565 | cfgStepWithStatement :: Statement -> FunctionCFG -> State -> (FunctionCFG, State) 566 | --cfgStepWithStatement Nothing cfg state = (cfg, state) 567 | 568 | 569 | 570 | cfgStepWithStatement Throw cfg state = let throwState = StatementState (nextLabel cfg) Throw 571 | transition = Transition{src = state, dst = throwState, condition = TT} 572 | transition2 = Transition{src = throwState, dst = ThrowState, condition = TT} 573 | in (addEndState (addStates (addTransitions cfg [transition, transition2]) [throwState, ThrowState]) ThrowState, ThrowState) 574 | 575 | cfgStepWithStatement (Return Nothing) cfg state = let returnState = StatementState (nextLabel cfg) (Return Nothing) 576 | transition = Transition{src = state, dst = returnState, condition = TT} 577 | transition2 = Transition{src = returnState, dst = ReturnState, condition = TT} 578 | in (addEndState (addStates (addTransitions cfg [transition, transition2]) [returnState, ReturnState]) ReturnState, ReturnState) 579 | 580 | cfgStepWithStatement (Return (Just expr)) cfg state = 581 | let (newCFG, newState) = cfgStepWithExpression expr cfg state 582 | transition = Transition{src = newState, dst = StatementState (nextLabel newCFG) ((Return (Just expr))), condition = TT} 583 | in ((addEndState (addState (addTransition newCFG transition) (dst transition)) (dst transition)), (dst transition)) 584 | 585 | 586 | 587 | cfgStepWithStatement (SimpleStatementExpression expr) cfg state = 588 | let (newCFG, newState) = cfgStepWithExpression expr cfg state 589 | stState = (StatementState (currentLabel newCFG) (SimpleStatementExpression expr)) 590 | -- transition = Transition{src = newState, dst = StatementState (nextLabel newCFG) ((SimpleStatementExpression expr)), condition = TT} 591 | in if isFunctionCallState newState 592 | then (newCFG, newState) 593 | else (replaceStateWithState newCFG newState stState, stState) 594 | 595 | cfgStepWithStatement (SimpleStatementVariableList identifierList (Just expr)) cfg state = 596 | let (newCFG, newState) = cfgStepWithExpression expr cfg state 597 | transition = Transition{src = newState, dst = StatementState (nextLabel newCFG) ((SimpleStatementVariableList identifierList (Just expr))), condition = TT} 598 | in ((addState (addTransition newCFG transition) (dst transition)), dst transition) 599 | 600 | cfgStepWithStatement (SimpleStatementVariableList identifierList Nothing) cfg state = 601 | let transition = Transition{src = state, dst = StatementState (nextLabel cfg) ((SimpleStatementVariableList identifierList Nothing)), condition = TT} 602 | in ((addState (addTransition cfg transition) (dst transition)), dst transition) 603 | 604 | cfgStepWithStatement (SimpleStatementVariableDeclarationList [] []) cfg state = (cfg, state) 605 | 606 | cfgStepWithStatement (SimpleStatementVariableDeclarationList ((Just dec):decs) (exp:exps)) cfg state = 607 | let (intermedCFG, intermedState) = cfgStepWithExpression exp cfg state 608 | decTransition = Transition{src = intermedState, dst = StatementState (nextLabel intermedCFG) (SimpleStatementVariableDeclarationList [Just dec] [exp]), condition = TT} 609 | (newCFG, newState) = ((addState (addTransition intermedCFG decTransition) (dst decTransition)), dst decTransition) 610 | in cfgStepWithStatement (SimpleStatementVariableDeclarationList decs exps) newCFG newState 611 | 612 | cfgStepWithStatement (SimpleStatementVariableDeclarationList ((Nothing):decs) (exp:exps)) cfg state = 613 | let (newCFG, newState) = cfgStepWithExpression exp cfg state 614 | in cfgStepWithStatement (SimpleStatementVariableDeclarationList decs exps) newCFG newState 615 | 616 | cfgStepWithStatement (BlockStatement (Block [])) cfg state = (cfg, state) 617 | cfgStepWithStatement (BlockStatement (Block (s : statements))) cfg state = let (newCFG, newState) = cfgStepWithStatement s cfg state 618 | in cfgStepWithStatement (BlockStatement (Block statements)) newCFG newState 619 | 620 | --can be optimized by ending in the end state of the true branch always, need to create another function with and end state parameter 621 | cfgStepWithStatement (IfStatement expression ifTrueStatement maybeIfFalseStatement) cfg state = 622 | let (newCFG, newState) = cfgStepWithExpression expression cfg state 623 | ifStmt = (IfStatement expression ifTrueStatement maybeIfFalseStatement) 624 | transitionToIf = Transition{src = newState, dst = StatementState (nextLabel newCFG) (ifStmt), condition = TT} 625 | 626 | transitionIfTrue = Transition{src = dst transitionToIf, dst = BasicState (nextLabel newCFG), condition = ConditionHolds (expression)} 627 | cfgWithTransition = addTransition (addStates newCFG [src transitionIfTrue, dst transitionIfTrue]) transitionIfTrue 628 | (cfgWithIfTrueBlock, ifTrueEndState) = (cfgStepWithStatement ifTrueStatement cfgWithTransition (dst transitionIfTrue)) 629 | 630 | transitionIfFalse = Transition{src = dst transitionToIf, dst = BasicState (nextLabel newCFG), condition = ConditionDoesNotHold (expression)} 631 | cfgIfTrueWithTransition = addTransition (addState cfgWithIfTrueBlock (dst transitionIfFalse)) transitionIfFalse 632 | (cfgWithIfFalseBlock, ifFalseEndState) = if(maybeIfFalseStatement /= Nothing) 633 | then let Just s = maybeIfFalseStatement 634 | in cfgStepWithStatement s cfgIfTrueWithTransition (dst transitionIfFalse) 635 | else (cfgIfTrueWithTransition, dst transitionIfFalse) 636 | bothEndState = BasicState (nextLabel cfgWithIfFalseBlock) 637 | cfgWithAllIfBlock = addTransition(addTransition cfgIfTrueWithTransition Transition{src = ifTrueEndState, dst = bothEndState, condition = TT}) Transition{src = ifFalseEndState, dst = bothEndState, condition = TT} 638 | in ((addState cfgWithAllIfBlock bothEndState), bothEndState) 639 | 640 | 641 | cfgStepWithStatement (WhileStatement expression statement) cfg startState = 642 | let (newCFG, newState) = cfgStepWithExpression expression cfg startState 643 | (branchingCFG, trueState, falseState) = cfgBranchOnConditionCheck expression newCFG newState 644 | (cfgWithLoopBody, bodyEndState) = cfgFromStatementWithContinueAndBreak statement branchingCFG trueState newState falseState 645 | transitionFromBodyEndState = Transition{src = bodyEndState, dst = newState, condition = TT} 646 | finishedCFG = addTransition cfgWithLoopBody transitionFromBodyEndState 647 | in (finishedCFG, falseState) 648 | 649 | 650 | -- DoWhileStatement Statement Expression 651 | 652 | 653 | cfgStepWithStatement (DoWhileStatement statement expression) cfg startState = 654 | let continueState = BasicState (nextLabel cfg) 655 | cfgWithContinueState = addState cfg continueState 656 | breakState = BasicState (nextLabel cfg) 657 | cfgWithBreakState = addState cfgWithContinueState breakState --cfg with both continue and break states 658 | (cfgWithStatement, endState) = cfgFromStatementWithContinueAndBreak statement cfgWithBreakState startState continueState breakState --CFG with body done once 659 | (newCFG, newState) = cfgStepWithExpression expression cfgWithStatement endState --CFG checking condition 660 | (branchingCFG, ifTrue, ifFalse) = cfgBranchOnConditionCheck expression newCFG newState 661 | --TODO check if continueState and breakState are reachable, if not don't use them 662 | --TODO can do step above manually, using break as false and continuestate as true 663 | breakTransition = Transition{src = breakState, dst = ifFalse, condition = TT} 664 | continueTransition = Transition{src = continueState, dst = startState, condition = TT} 665 | connectingEndOfBlockTransition = Transition{src = ifTrue, dst = continueState, condition = TT} 666 | finishedCFG = addTransition (addTransition (addTransition branchingCFG breakTransition) continueTransition) connectingEndOfBlockTransition 667 | in (finishedCFG, ifFalse) 668 | 669 | -- ForStatement (Maybe Statement, Maybe Expression, Maybe Expression) Statement 670 | 671 | 672 | --infinite loop 673 | --cfgStepWithStatement (ForStatement Nothing Nothing Nothing) statement) cfg startState = 674 | -- let continueState = BasicState{label = nextLabel cfg} 675 | -- cfgWithContinueState = addState cfg continueState 676 | -- breakState = BasicState{label = nextLabel cfg} 677 | -- cfgWithBreakState = addState cfg breakState 678 | -- (cfgWithStatement, endState) = cfgFromStatementWithContinueAndBreak statement cfgWithBreakState startState continueState breakState 679 | -- loopTransition = Transition{src = endState, dst = startState, label = TT} 680 | -- finishedCFG = addTransition cfgWithStatement loopTransition 681 | -- in (finishedCFG, endState) 682 | 683 | 684 | 685 | 686 | --cfgStepWithStatement (ForStatement Just statement1 expression1 Nothing) statement) cfg startState = 687 | -- let initialStatementState = BasicState{label = nextLabel cfg} 688 | -- cfgWithInitialStatementState = addState cfg initialStatementState 689 | -- initialTransition = Transition{src = startState, dst = initialStatementState, label = Statement statement1} 690 | -- cfgWithInitialTransition = addTransition cfgWithInitialStatementState initialTransition 691 | -- conditionTrueState = BasicState{label = nextLabel cfg} 692 | -- cfgWithTrueState = addState cfgWithInitialTransition conditionTrueState 693 | -- conditionCheckTrueTransition = Transition{src = initialStatementState, dst = conditionTrueState, label = ConditionHolds expression1} 694 | -- conditionFalseState = BasicState{label = nextLabel cfg} 695 | -- cfgWithFalseState = addState cfgWithTrueState conditionTrueState 696 | -- conditionCheckTrueTransition = Transition{src = initialStatementState, dst = conditionFalseState, label = ConditionDoesNotHold expression1} 697 | -- cfgWithTrueAndFalseTransitions = addTransition addTransition cfgWithFalseState conditionCheckTrueTransition conditionCheckTrueTransition 698 | -- (cfgWithStatement, endState) = cfgFromStatementWithContinueAndBreak statement cfgWithTrueAndFalseTransitions conditionTrueState initialStatementState endState 699 | -- endStateTTTransition = Transition{src = endState, dst = initialStatementState, label = TT} 700 | -- finishedCFG = addTransition cfgWithStatement endStateTTTransition 701 | -- in (finishedCFG, conditionFalseState) 702 | 703 | 704 | cfgStepWithStatement (ForStatement (statement1, expression1, expression2) statement) cfg startState = 705 | let (cfgWithStatement1, stateAfterInitialStatement) = cfgStepWithMaybeStatement statement1 cfg startState -- do first statement 706 | (cfgWithExpression1, stateAfterConditionCheck) = cfgStepWithMaybeExpression expression1 cfgWithStatement1 stateAfterInitialStatement --check condition 707 | conditionTrueState = BasicState (nextLabel cfgWithExpression1) 708 | conditionCheckTrueTransition = Transition{src = stateAfterConditionCheck, dst = conditionTrueState, condition = if(expression1 /= Nothing) 709 | then let Just e = expression1 710 | in ConditionHolds (e) 711 | else TT}--no condition means true 712 | cfgWithTrueState = addTransition (addState cfgWithExpression1 conditionTrueState) conditionCheckTrueTransition --add condition holds transition 713 | conditionFalseState = BasicState (nextLabel cfgWithTrueState) 714 | conditionCheckFalseTransition = Transition{src = stateAfterConditionCheck, dst = conditionFalseState, condition = if(expression1 /= Nothing) 715 | then let Just e = expression1 716 | in ConditionDoesNotHold (e) 717 | else TT} --will not be added in this case 718 | cfgWithFalseState = if(expression1 /= Nothing) 719 | then addTransition (addState cfgWithTrueState conditionTrueState) conditionCheckFalseTransition 720 | else cfgWithTrueState --condition is always true so no false transition 721 | continueFromState = BasicState (nextLabel cfgWithFalseState) --state to take in case of continue 722 | cfgWithContinueState = addState cfgWithFalseState continueFromState 723 | (cfgWithStatement, endState) = cfgFromStatementWithContinueAndBreak statement cfgWithContinueState conditionTrueState continueFromState conditionFalseState 724 | finishedCFG = if(endState == conditionFalseState) --if statement always end in break 725 | then cfgWithStatement --then existing CFG is enough 726 | else let fromEndToContinueTransition = Transition{src = endState, dst = continueFromState, condition = TT}--else connect end state to continuefrom state (note that continuefrom may have been used in some banch of statement, thus why we do this) 727 | cfgWithTransition = addTransition cfgWithStatement fromEndToContinueTransition 728 | (cfgWithExpression2, afterExpression2State) = cfgStepWithMaybeExpression expression2 cfgWithTransition continueFromState --perform expression2 before checking expression1 again 729 | transitionFromEndToStart = Transition{src = afterExpression2State, dst = stateAfterInitialStatement, condition = TT} 730 | in addTransition cfgWithExpression2 transitionFromEndToStart 731 | in (finishedCFG, conditionFalseState) 732 | 733 | --Error because expression2 are MaybeExpression type 734 | cfgStepWithStatement any cfg state = let transition = Transition{src = state, dst = StatementState (nextLabel cfg) any, condition = TT} 735 | in ((addState (addTransitions cfg [transition]) (dst transition)), dst transition) 736 | -------------------------------------------------------------- 737 | -------------------------------------------------------------- 738 | 739 | cfgStepWithMaybeStatement :: Maybe Statement -> FunctionCFG -> State -> (FunctionCFG, State) 740 | cfgStepWithMaybeStatement Nothing cfg state = (cfg, state) 741 | cfgStepWithMaybeStatement (Just statement) cfg state = cfgStepWithStatement statement cfg state 742 | 743 | -------------------------------------------------------------- 744 | -------------------------------------------------------------- 745 | --handles continue in while and for 746 | --continue jumps over one iteration of the loop 747 | --break exits the loop 748 | 749 | cfgBranchOnConditionCheck :: Expression -> FunctionCFG -> State -> (FunctionCFG, State, State) 750 | cfgBranchOnConditionCheck expression cfg state = 751 | let conditionTrueState = BasicState (nextLabel cfg) 752 | trueTransition = Transition{src = state, dst = conditionTrueState, condition = ConditionHolds (expression)} 753 | cfgWithExpressionWithTrueState = addTransition (addState cfg conditionTrueState) trueTransition 754 | conditionFalseState = BasicState (nextLabel cfgWithExpressionWithTrueState) 755 | falseTransition = Transition{src = state, dst = conditionFalseState, condition = ConditionDoesNotHold (expression)} 756 | cfgWithExpressionWithFalseState = addTransition (addState cfgWithExpressionWithTrueState conditionFalseState) falseTransition 757 | in (cfgWithExpressionWithFalseState, conditionTrueState, conditionFalseState) 758 | 759 | -------------------------------------------------------------- 760 | -------------------------------------------------------------- 761 | 762 | joinStates :: FunctionCFG -> State -> State -> (FunctionCFG, State) 763 | joinStates cfg state1 state2 = let newEndState = BasicState (nextLabel cfg) 764 | transition1 = Transition{src = state1, dst = newEndState, condition = TT} 765 | transition2 = Transition{src = state2, dst = newEndState, condition = TT} 766 | newCFG = addTransition (addTransition (addState cfg newEndState) transition1) transition2 767 | in (newCFG, newEndState) 768 | 769 | -------------------------------------------------------------- 770 | -------------------------------------------------------------- 771 | 772 | cfgFromStatementWithContinueAndBreak :: Statement -> FunctionCFG -> State -> State -> State -> (FunctionCFG, State) 773 | cfgFromStatementWithContinueAndBreak (IfStatement expression statement maybeStatement) cfg startState continueFrom breakFrom = 774 | let (cfgWithExpression, afterExpression) = cfgStepWithExpression expression cfg startState 775 | (cfgWithBranching, trueState, falseState) = cfgBranchOnConditionCheck expression cfgWithExpression afterExpression 776 | (cfgWithStatement, endStateIfTrue) = cfgFromStatementWithContinueAndBreak statement cfgWithBranching trueState continueFrom breakFrom 777 | (cfgWithStatementAndElse, endStateIfFalse) = 778 | if(maybeStatement /= Nothing) 779 | then let Just elseStmt = maybeStatement 780 | in cfgFromStatementWithContinueAndBreak elseStmt cfgWithStatement falseState continueFrom breakFrom 781 | else (cfgWithStatement, falseState) 782 | in if(endStateIfFalse /= continueFrom && endStateIfFalse /= breakFrom) 783 | then 784 | if(endStateIfTrue /= continueFrom && endStateIfTrue /= breakFrom) 785 | then joinStates cfgWithStatementAndElse endStateIfTrue endStateIfFalse 786 | else (cfgWithStatementAndElse, endStateIfFalse) 787 | 788 | else if(endStateIfTrue /= continueFrom && endStateIfTrue /= breakFrom) 789 | then (cfgWithStatementAndElse, endStateIfTrue) 790 | else (cfgWithStatementAndElse, endStateIfFalse) 791 | 792 | 793 | cfgFromStatementWithContinueAndBreak (BlockStatement (Block (Continue:statements))) cfg startState continueFrom _ = 794 | cfgFromStatementWithContinueAndBreak Continue cfg startState continueFrom continueFrom 795 | 796 | cfgFromStatementWithContinueAndBreak (BlockStatement (Block (Break:statements))) cfg startState _ breakTo = 797 | cfgFromStatementWithContinueAndBreak Break cfg startState breakTo breakTo 798 | 799 | 800 | cfgFromStatementWithContinueAndBreak (BlockStatement (Block (s:statements))) cfg startState continueFrom breakTo = 801 | let (newCFG, newState) = cfgFromStatementWithContinueAndBreak s cfg startState continueFrom breakTo 802 | in cfgFromStatementWithContinueAndBreak (BlockStatement (Block statements)) newCFG newState continueFrom breakTo 803 | 804 | cfgFromStatementWithContinueAndBreak Continue cfg startState continueFrom _ = 805 | let continueState = StatementState (nextLabel cfg) (Continue) 806 | transition = Transition{src = startState, dst = continueState, condition = TT} 807 | transition2 = Transition{src = continueState, dst = continueFrom, condition = TT} 808 | in (addTransitions (addState cfg continueState) [transition,transition2], continueFrom) 809 | 810 | cfgFromStatementWithContinueAndBreak Break cfg startState _ breakTo = 811 | let breakState = StatementState (nextLabel cfg) (Break) 812 | transition = Transition{src = startState, dst = breakState, condition = TT} 813 | transition2 = Transition{src = breakState, dst = breakTo, condition = TT} 814 | in (addTransitions (addState cfg breakState) [transition, transition2], breakTo) 815 | 816 | cfgFromStatementWithContinueAndBreak statement cfg startState continueFrom breakTo = cfgStepWithStatement statement cfg startState 817 | 818 | -------------------------------------------------------------- 819 | -------------------------------------------------------------- 820 | 821 | alphabet :: FunctionCFG -> [Condition] 822 | alphabet cfg = [condition transition | transition <- (transitions cfg)] 823 | 824 | -------------------------------------------------------------- 825 | -------------------------------------------------------------- 826 | 827 | 828 | --Replace state with given controlflow 829 | replaceStateWith :: FunctionCFG -> State -> (State, [Transition], [State]) -> FunctionCFG 830 | replaceStateWith cfg state (startHere, trans, endHere) = FunctionCFG{ 831 | signature = signature cfg, 832 | transitions = [Transition s startHere label | Transition s state label <- transitions cfg] 833 | ++ [Transition e s label | e <- endHere, Transition state s label <- transitions cfg] 834 | ++ trans 835 | ++ [t | t <- transitions cfg, src t /= state, dst t /= state], 836 | states = (((states cfg) \\ [state]) ++ [startHere]) ++ endHere, 837 | initial = if state == (initial cfg) 838 | then startHere 839 | else (initial cfg), 840 | end = if elem state (end cfg) 841 | then ((end cfg) \\ [state]) ++ endHere 842 | else (end cfg) 843 | } 844 | 845 | 846 | -------------------------------------------------------------- 847 | -------------------------------------------------------------- 848 | 849 | 850 | --Replace state with given controlflow 851 | replaceStateWithCFG :: FunctionCFG -> State -> FunctionCFG -> FunctionCFG 852 | replaceStateWithCFG cfg state cfgg = FunctionCFG{ 853 | signature = signature cfg, 854 | transitions = [Transition s (initial cfgg) label | Transition s state label <- transitions cfg] 855 | ++ [Transition e s label | e <- end cfgg, Transition state s label <- transitions cfg] 856 | ++ [t | t <- transitions cfg, src t /= state, dst t /= state], 857 | states = ((states cfg) \\ [state]) ++ (states cfgg), 858 | initial = if state == (initial cfg) 859 | then initial cfgg 860 | else (initial cfg), 861 | end = if elem state (end cfg) 862 | then ((end cfg) \\ [state]) 863 | else (end cfg) 864 | } 865 | 866 | -------------------------------------------------------------- 867 | -------------------------------------------------------------- 868 | 869 | --Replace state with given controlflow 870 | replaceStateWithState :: FunctionCFG -> State -> State -> FunctionCFG 871 | replaceStateWithState cfg state newState = FunctionCFG{ 872 | signature = signature cfg, 873 | transitions = [Transition s newState label | Transition s ss label <- transitions cfg, ss == state] 874 | ++ [Transition newState s label | Transition ss s label <- transitions cfg, ss == state] 875 | ++ [t | t <- transitions cfg, src t /= state, dst t /= state], 876 | states = ((states cfg) \\ [state]) ++ [newState], 877 | initial = if state == (initial cfg) 878 | then newState 879 | else (initial cfg), 880 | end = if elem state (end cfg) 881 | then ((end cfg) \\ [state]) ++ [newState] 882 | else (end cfg) 883 | } 884 | 885 | -------------------------------------------------------------- 886 | -------------------------------------------------------------- 887 | 888 | handleAssertAndRequires :: [FunctionCFG] -> FunctionCFG -> FunctionCFG 889 | handleAssertAndRequires (cfgs) cfg = let requireStates = [s | s <- (states cfg), not (requireIsOverridden cfgs), functionCallIsRequire s] 890 | assertStates = [s | s <- (states cfg), not (requireIsOverridden cfgs), functionCallIsAssert s] 891 | nonFunctionCallStates = [StatementState l s | StatementState l s <- (states cfg)] 892 | newCFGWithAssertAndRequire = functionCallStatesToAssertOrRequire (requireStates ++ assertStates) cfg 893 | x = head requireStates 894 | in newCFGWithAssertAndRequire 895 | 896 | -------------------------------------------------------------- 897 | -------------------------------------------------------------- 898 | 899 | assertIsOverridden :: [FunctionCFG] -> Bool 900 | assertIsOverridden [] = False 901 | assertIsOverridden (cfg:cfgs) = if((functionName (signature cfg)) == Identifier "assert") 902 | then True 903 | else assertIsOverridden cfgs 904 | 905 | requireIsOverridden :: [FunctionCFG] -> Bool 906 | requireIsOverridden [] = False 907 | requireIsOverridden (cfg:cfgs) = if(functionName (signature cfg) == Identifier "require") 908 | then True 909 | else requireIsOverridden cfgs 910 | 911 | -------------------------------------------------------------- 912 | -------------------------------------------------------------- 913 | 914 | reLabelTransition :: Transition -> Condition -> Transition 915 | reLabelTransition (Transition s d l) ll = Transition s d ll 916 | -------------------------------------------------------------- 917 | -------------------------------------------------------------- 918 | --data FunctionCall = FunctionCall FunctionName (Maybe (Either NameValueList ExpressionList)) deriving (Eq, Ord, Show) 919 | 920 | functionCallStatesToAssertOrRequire :: [State] -> FunctionCFG -> FunctionCFG 921 | functionCallStatesToAssertOrRequire [] cfg = cfg 922 | functionCallStatesToAssertOrRequire (s:ss) cfg = let newCFG = functionCallToAssertOrRequire s cfg 923 | in functionCallStatesToAssertOrRequire ss newCFG 924 | 925 | 926 | -- data FunctionCall = FunctionCall FunctionName (Maybe (Either NameValueList ExpressionList)) 927 | -- | OutsideFunctionCall (Just expression) FunctionName (Maybe (Either NameValueList ExpressionList)) deriving (Eq, Ord, Show) 928 | 929 | functionCallToAssertOrRequire :: State -> FunctionCFG -> FunctionCFG 930 | functionCallToAssertOrRequire (FunctionCallState label (FunctionCall (Identifier "require") (Just (Right (ExpressionList [expression]))))) cfg = 931 | let callState = (FunctionCallState label (FunctionCall (Identifier "require") (Just (Right (ExpressionList [expression]))))) 932 | newState = (StatementState label (SimpleStatementExpression (FunctionCallExpressionList (Literal (PrimaryExpressionIdentifier (Identifier {unIdentifier = "require"}))) (Just ((ExpressionList [expression])))))) 933 | newCFG = replaceStateWithState cfg callState newState 934 | newTransitions = let existingTransitions = [reLabelTransition t (ConditionHolds (expression)) | t <- (transitions newCFG), src t == newState] 935 | in if null existingTransitions 936 | then [Transition newState ReturnState (ConditionHolds (expression))] 937 | else existingTransitions 938 | falseTransition = Transition newState RevertState (ConditionDoesNotHold (expression)) 939 | otherTransitions = (transitions newCFG) \\ [t | t <- (transitions newCFG), src t == newState] 940 | in FunctionCFG{ 941 | signature = signature newCFG, 942 | transitions = otherTransitions ++ [falseTransition] ++ newTransitions, 943 | states = states newCFG ++ [RevertState], 944 | initial = initial newCFG, 945 | end = end newCFG 946 | } 947 | 948 | functionCallToAssertOrRequire (FunctionCallState label (FunctionCall (Identifier "assert") (Just (Right (ExpressionList [expression]))))) cfg = 949 | let callState = (FunctionCallState label (FunctionCall (Identifier "assert") (Just (Right (ExpressionList [expression]))))) 950 | newState = (StatementState label (SimpleStatementExpression (FunctionCallExpressionList (Literal (PrimaryExpressionIdentifier (Identifier {unIdentifier = "assert"}))) (Just ((ExpressionList [expression])))))) 951 | newCFG = replaceStateWithState cfg callState newState 952 | 953 | newTransitions = let existingTransitions = [reLabelTransition t (ConditionHolds (expression)) | t <- (transitions newCFG), src t == newState] 954 | in if null existingTransitions 955 | then [Transition newState ReturnState (ConditionHolds (expression))] 956 | else existingTransitions 957 | falseTransition = Transition newState ThrowState (ConditionDoesNotHold (expression)) 958 | otherTransitions = (transitions newCFG) \\ [t | t <- (transitions newCFG), src t /= newState] 959 | in FunctionCFG{ 960 | signature = signature newCFG, 961 | transitions = otherTransitions ++ [falseTransition] ++ newTransitions, 962 | states = states newCFG ++ [RevertState], 963 | initial = initial newCFG, 964 | end = end newCFG 965 | } 966 | 967 | functionCallToAssertOrRequire _ cfg = cfg 968 | 969 | -------------------------------------------------------------- 970 | -------------------------------------------------------------- 971 | 972 | functionCallIsRequire:: State -> Bool 973 | functionCallIsRequire (FunctionCallState _ (FunctionCall (Identifier "require") _)) = True 974 | functionCallIsRequire _ = False 975 | 976 | functionCallIsAssert :: State -> Bool 977 | functionCallIsAssert (FunctionCallState _ (FunctionCall (Identifier "assert") _)) = True 978 | functionCallIsAssert _ = False 979 | 980 | -------------------------------------------------------------- 981 | -------------------------------------------------------------- 982 | 983 | isFunctionCallState :: State -> Bool 984 | isFunctionCallState (FunctionCallState _ _) = True 985 | isFunctionCallState _ = False 986 | 987 | -------------------------------------------------------------- 988 | -------------------------------------------------------------- 989 | 990 | isAssert :: Expression -> Bool 991 | isAssert (Literal (PrimaryExpressionIdentifier (Identifier {unIdentifier = "assert"}))) = True 992 | isAssert _ = False 993 | 994 | isRequire :: Expression -> Bool 995 | isRequire (Literal (PrimaryExpressionIdentifier (Identifier {unIdentifier = "require"}))) = True 996 | isRequire _ = False 997 | 998 | 999 | -------------------------------------------------------------- 1000 | -------------------------------------------------------------- 1001 | 1002 | -------------------------------------------------------------- 1003 | -------------------------------------------------------------- 1004 | --TODO 1005 | --need to handle function modifiers 1006 | --delegatecall and call not being parsed 1007 | 1008 | 1009 | 1010 | 1011 | 1012 | -------------------------------------------------------------- 1013 | -------------------------------------------------------------- 1014 | --comparePropertyEventAndCFGLabel :: DEA.Event -> Condition -> Bool 1015 | 1016 | -------------------------------------------------------------- 1017 | -------------------------------------------------------------- 1018 | 1019 | --TODO: 1020 | --function f() returns (uint i){i = 6;} is equivalent to function f() returns (uint){i = 6; return i;} 1021 | -------------------------------------------------------------------------------- /src/CFG/Parsing.hs: -------------------------------------------------------------------------------- 1 | module CFG.Parsing (module Parseable) where 2 | 3 | import Control.Monad 4 | import Text.Parsec hiding (State, label) 5 | import Text.Parsec.String 6 | import Text.Parsec.Number 7 | import Data.Char hiding (DecimalNumber) 8 | import Data.List 9 | import Parseable 10 | 11 | import Solidity.Solidity 12 | import Solidity.Parsing 13 | 14 | import CFG.CFG 15 | 16 | --Failure-safe choice 17 | 18 | 19 | instance Parseable State where 20 | parser = do no <- many alphaNum 21 | char '\"' 22 | functionCall <- parser 23 | char '\"' 24 | return (FunctionCallState no functionCall) 25 | <||> do no <- many alphaNum 26 | spaces *> char ':' <* spaces 27 | functionCall <- parser 28 | return (FunctionCallState no functionCall) 29 | <||> do no <- many alphaNum 30 | spaces *> char ':' <* spaces 31 | stmt <- parser 32 | return (StatementState no stmt) 33 | <||> do no <- many alphaNum 34 | spaces *> char ':' <* spaces 35 | expr <- parser 36 | return (ExpressionState no expr) 37 | <||> do string "throw" 38 | return ThrowState 39 | <||> do string "revert" 40 | return RevertState 41 | <||> do string "return" 42 | return ReturnState 43 | <||> do no <- many alphaNum 44 | return (BasicState{label = no}) 45 | display ThrowState = "throw" 46 | display ReturnState = "return" 47 | display (RevertState) = "revert" 48 | display (StatementState l stmt) = "\"" ++ l ++ " : " ++ display stmt ++ "\"" 49 | display (ExpressionState l expr) = "\"" ++ l ++ " : " ++ display expr ++ "\"" 50 | display (BasicState l) = show l 51 | display (FunctionCallState l functionCall) = "\"" ++ l ++ " : " ++ display functionCall ++ "\"" 52 | -- display _ = "state" 53 | -- display (ContractCallState l contractAddress (Identifier functionName)) = show l ++ " : " ++ contractAddress ++ "." ++ functionName ++ "()" 54 | -- display (ContractDelegateCallState l contractAddress (Identifier functionName)) = show l ++ " : " ++ contractAddress ++ "#" ++ functionName ++ "()" 55 | 56 | instance Parseable FunctionCall where 57 | parser = do functionName <- manyTill alphaNum (char '(' <* spaces) 58 | (char ')') 59 | return (FunctionCall (Identifier functionName) Nothing) 60 | <||> do functionName <- manyTill alphaNum (char '(' <* spaces) 61 | expressionList <- parser 62 | (char ')') 63 | return (FunctionCall (Identifier functionName) (Just (Right expressionList))) 64 | <||> do functionName <- manyTill alphaNum (char '(' <* spaces) 65 | nameValueList <- parser 66 | (char ')') 67 | return (FunctionCall (Identifier functionName) (Just (Left nameValueList))) 68 | <||> do expression <- parser 69 | char '.' 70 | functionName <- manyTill alphaNum (char '(' <* spaces) 71 | (char ')') 72 | return (OutsideFunctionCall expression (Identifier functionName) Nothing) 73 | <||> do expression <- parser 74 | char '.' 75 | functionName <- manyTill alphaNum (char '(' <* spaces) 76 | expressionList <- parser 77 | (char ')') 78 | return (OutsideFunctionCall expression (Identifier functionName) (Just (Right expressionList))) 79 | <||> do expression <- parser 80 | char '.' 81 | functionName <- manyTill alphaNum (char '(' <* spaces) 82 | nameValueList <- parser 83 | (char ')') 84 | return (OutsideFunctionCall expression (Identifier functionName) (Just (Left nameValueList))) 85 | display (FunctionCall functionName Nothing) = display functionName 86 | display (FunctionCall functionName (Just (Left nameValueList))) = display functionName ++ "(" ++ (display nameValueList) ++ ")" 87 | display (FunctionCall functionName (Just (Right expressionList))) = display functionName ++ "(" ++ (display expressionList) ++ ")" 88 | display (OutsideFunctionCall expression functionName (Nothing)) = display expression ++ "." ++ display functionName 89 | display (OutsideFunctionCall expression functionName (Just (Left nameValueList))) = display expression ++ "." ++ display functionName ++ "(" ++ (display nameValueList) ++ ")" 90 | display (OutsideFunctionCall expression functionName (Just (Right expressionList))) = display expression ++ "." ++ display functionName ++ "(" ++ (display expressionList) ++ ")" 91 | 92 | instance Parseable Condition where 93 | parser = do expression <- parser 94 | spaces 95 | string "==" 96 | spaces 97 | string "true" 98 | return (ConditionHolds (expression)) 99 | <||> do expression <- parser 100 | spaces 101 | string "==" 102 | spaces 103 | string "false" 104 | return (ConditionDoesNotHold (expression)) 105 | <||> do string "false" 106 | return (FF) 107 | <||> do string "true" 108 | return (TT) 109 | display (ConditionDoesNotHold expression) = (display expression) ++ " == false" 110 | display (ConditionHolds expression) = (display expression) ++ " == true" 111 | display (TT) = "true" 112 | display (FF) = "false" 113 | 114 | 115 | instance Parseable Transition where 116 | parser = do src <- parser 117 | spaces 118 | string "->" 119 | dst <- parser 120 | spaces 121 | char '[' 122 | spaces 123 | string "label" 124 | spaces 125 | char '=' 126 | spaces 127 | char '"' 128 | condition <- parser 129 | char '"' 130 | return (Transition (src) (dst) (condition)) 131 | display (Transition src dst condition) = (display src) ++ " -> " ++ (display dst) ++ " [label = \"" ++ (display condition) ++ "\"];\n" 132 | 133 | 134 | --data FunctionSignature = FunctionSignature{ 135 | -- functionName :: Identifier, 136 | -- parameters :: ParameterList, 137 | -- returnParams :: ParameterList 138 | -- } deriving (Eq, Ord, Show) 139 | 140 | 141 | instance Parseable FunctionSignature where 142 | parser = do name <- parser 143 | spaces 144 | char '(' 145 | spaces 146 | parameterList <- parser 147 | spaces 148 | char ')' 149 | spaces 150 | visibility <- parser 151 | spaces 152 | string "returns(" 153 | spaces 154 | returnParamsList <- parser 155 | spaces 156 | char ')' 157 | return (FunctionSignature name visibility parameterList returnParamsList) 158 | 159 | display (FunctionSignature name visibility parameterList returnParamsList) = display name ++ display parameterList ++ " " ++ display visibility ++ " returns" ++ display returnParamsList ++ "" 160 | 161 | instance Parseable FunctionVisibility where 162 | parser = try 163 | (do string "private" 164 | return Private) 165 | <|> try 166 | (do string "external" 167 | return FExternal) 168 | <|> try 169 | (do string "internal" 170 | return FInternal) 171 | <|> do return Public 172 | display Public = "public" 173 | display Private = "private" 174 | display FExternal = "external" 175 | display FInternal = "internal" 176 | 177 | 178 | instance Parseable FunctionCFG where 179 | parser = do string "digraph" 180 | spaces 181 | char '"' 182 | spaces 183 | signat <- parser 184 | char '"' 185 | spaces 186 | char '{' 187 | spaces 188 | string "initial" 189 | spaces 190 | string "->" 191 | spaces 192 | initialState <- parser 193 | spaces 194 | char ';' 195 | spaces 196 | endStates <- many (parser <* spaces <* string "->" <* spaces <* string "end" <* spaces <* char ';') 197 | transitionList <- many parser 198 | spaces 199 | -- try string "labelloc=\"t\";" 200 | -- string "label=\"" 201 | -- spaces 202 | -- signat <- parser 203 | -- spaces 204 | -- string "\";" 205 | -- spaces 206 | char '}' 207 | eof 208 | return FunctionCFG{signature = signat, transitions = transitionList, states = statesFromTransitions transitionList [], initial = initialState, end = endStates} 209 | 210 | display cfg = "digraph \"" ++ display (signature cfg) ++ "\"{\n" ++ 211 | -- "initial -> " ++ display (initial cfg) ++ ";\n" ++ 212 | foldr (++) "" (map display (transitions cfg)) ++ 213 | -- foldr (++) "" [display state ++ " -> end" ++ ";\n" | state <- (nub (end cfg))] ++ 214 | foldr (++) "" (nub [display (ExpressionState label expr) ++ "[style=filled, color=gray]" ++ ";\n" | Transition (ExpressionState label expr) _ _ <- (transitions cfg)]) ++ 215 | foldr (++) "" (nub [display (ExpressionState label expr) ++ "[style=filled, color=gray]" ++ ";\n" | Transition _ (ExpressionState label expr) _ <- (transitions cfg)]) ++ 216 | foldr (++) "" (nub [display (FunctionCallState label expr) ++ "[style=filled, color=lightblue]" ++ ";\n" | Transition _ (FunctionCallState label expr) _ <- (transitions cfg), isOutsideFunctionCall expr]) 217 | ++ "\n}" 218 | 219 | isOutsideFunctionCall :: FunctionCall -> Bool 220 | isOutsideFunctionCall (OutsideFunctionCall _ _ _) = True 221 | isOutsideFunctionCall _ = False 222 | 223 | instance Parseable CFG where 224 | parser = do cfgList <- many parser 225 | return (CFG cfgList) 226 | display (CFG []) = "" 227 | display (CFG (c:cs)) = (display c) ++ "\n" ++ (display (CFG cs)) 228 | 229 | statesFromTransitions :: [Transition] -> [State] -> [State] 230 | statesFromTransitions [] states = states 231 | statesFromTransitions ((Transition src dst _):ts) states = 232 | let newStates = statesFromTransitions ts states 233 | withSource = if(elem src states) 234 | then newStates 235 | else newStates ++ [src] 236 | withDest = if(elem dst states) 237 | then withSource 238 | else withSource ++ [dst] 239 | in withDest 240 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Licensed under the Apache License, Version 2.0 (the "License"); 3 | -- you may not use this file except in compliance with the License. 4 | -- You may obtain a copy of the License at 5 | -- 6 | -- http://www.apache.org/licenses/LICENSE-2.0 7 | -- 8 | -- Unless required by applicable law or agreed to in writing, software 9 | -- distributed under the License is distributed on an "AS IS" BASIS, 10 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 11 | -- See the License for the specific language governing permissions and 12 | -- limitations under the License. 13 | 14 | module Main where 15 | 16 | import System.Environment 17 | import System.Exit 18 | import Control.Exception.Base 19 | import System.IO 20 | import System.IO.Error 21 | 22 | import Text.Parsec hiding (try) 23 | import Text.Parsec.String 24 | import Solidity 25 | import CFG 26 | 27 | type Filename = String 28 | 29 | failWith :: IO a -> String -> IO a 30 | io `failWith` e = io `catch` (const $ (fail e) :: IOError -> IO a) 31 | 32 | ifNot :: Bool -> String -> IO () 33 | ifNot c e = if c then return () else fail e 34 | 35 | parseIO :: Parseable a => Filename -> String -> IO a 36 | parseIO filename = either (fail . (parseError ++) . show) return . parse parser "" 37 | where 38 | parseError = "Error during parsing of <"++filename++">\n" 39 | 40 | mainSA inFile outFile= 41 | do 42 | let 43 | inputText <- readFile inFile 44 | `failWith` ("Cannot read Solidity file <"++inFile++">") 45 | solidityCode <- parseIO inFile inputText 46 | let outCode = display (contractCFG solidityCode) 47 | writeFile outFile (outCode) 48 | `failWith` ("Cannot write to Solidity file <"++outFile++">") 49 | putStrLn ("Created contract-flow graph file <"++outFile++">") 50 | `catch` (putStrLn . ioeGetErrorString) 51 | 52 | main = 53 | do 54 | arguments <- getArgs 55 | ifNot (length arguments == 2) 56 | ("Usage: ") 57 | let [inFile, outFile] = arguments 58 | inputText <- readFile inFile 59 | `failWith` ("Cannot read Solidity file <"++inFile++">") 60 | solidityCode <- parseIO inFile inputText 61 | let outCode = display (contractCFG solidityCode) 62 | writeFile outFile (outCode) 63 | `failWith` ("Cannot write to Solidity file <"++outFile++">") 64 | putStrLn ("Created contract-flow graph file <"++outFile++">") 65 | `catch` (putStrLn . ioeGetErrorString) --------------------------------------------------------------------------------