ethereum-analyzer 3.0.0 → 3.1.0

raw patch · 18 files changed

+467/−404 lines, 18 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ethereum-analyzer.cabal +5/−2
• src/Ethereum/Analyzer/EVM/CfgAugWithTopNPass.hs +44/−51
• src/Ethereum/Analyzer/EVM/CfgAugmentPass.hs +13/−16
• src/Ethereum/Analyzer/EVM/IR.hs +61/−45
• src/Ethereum/Analyzer/EVM/Util.hs +4/−43
• src/Ethereum/Analyzer/Solidity.hs +2/−0
• src/Ethereum/Analyzer/Solidity/Finding.hs +2/−2
• src/Ethereum/Analyzer/Solidity/Foreach.hs +1/−1
• src/Ethereum/Analyzer/Solidity/Hoople.hs +107/−0
• src/Ethereum/Analyzer/Solidity/Simple.hs +5/−5
• src/Ethereum/Analyzer/Util.hs +55/−0
• test/Ethereum/Analyzer/EVM/CfgAugWithTopNPassSpec.hs +2/−2
• test/Ethereum/Analyzer/EVM/CfgAugmentPassSpec.hs +22/−23
• test/Ethereum/Analyzer/EVM/IRSpec.hs +30/−29
• test/Ethereum/Analyzer/EVM/UtilSpec.hs +47/−150
• test/Ethereum/Analyzer/Solidity/ForeachSpec.hs +2/−2
• test/Ethereum/Analyzer/Solidity/HoopleSpec.hs +32/−0
• test/Ethereum/Analyzer/Solidity/SimpleSpec.hs +33/−33

@@ -1,5 +1,5 @@ name:                ethereum-analyzer-version:             3.0.0+version:             3.1.0 synopsis:            A Ethereum contract analyzer. homepage:            https://github.com/zchn/ethereum-analyzer license:             Apache-2.0@@ -21,7 +21,7 @@ source-repository this   type:     git   location: https://github.com/zchn/ethereum-analyzer-  tag:      v3.0.0+  tag:      v3.1.0   subdir:   ethereum-analyzer  library@@ -48,6 +48,7 @@                      , Ethereum.Analyzer.EVM                      , Ethereum.Analyzer.Debug                      , Ethereum.Analyzer.Solidity+                     , Ethereum.Analyzer.Util   other-modules:       Ethereum.Analyzer.EVM.IR                      , Ethereum.Analyzer.EVM.CfgAugmentPass                      , Ethereum.Analyzer.EVM.CfgAugWithTopNPass@@ -56,6 +57,7 @@                      , Ethereum.Analyzer.Solidity.AstJson                      , Ethereum.Analyzer.Solidity.Finding                      , Ethereum.Analyzer.Solidity.Foreach+                     , Ethereum.Analyzer.Solidity.Hoople                      , Ethereum.Analyzer.Solidity.Simple   ghc-options:         -Wall   hs-source-dirs:      src@@ -75,6 +77,7 @@                      , Ethereum.Analyzer.EVM.UtilSpec                      , Ethereum.Analyzer.Solidity.AstJsonSpec                      , Ethereum.Analyzer.Solidity.ForeachSpec+                     , Ethereum.Analyzer.Solidity.HoopleSpec                      , Ethereum.Analyzer.Solidity.SimpleSpec                      , Ethereum.Analyzer.SoliditySpec                      , Ethereum.Analyzer.TestData.Asts

@@ -154,6 +154,8 @@     ocT :: HplOp O C -> StackNFact -> FactBase StackNFact     -- TODO(zchn): Implement JUMPI narrowing     ocT hplop@(OcOp (_, op) _) f = distributeFact hplop (opT op f)+    ocT hplop@(HpJump _ _) f = distributeFact hplop f+    ocT hplop@(HpEnd _) f = distributeFact hplop f     opT :: Operation -> StackNFact -> StackNFact     opT STOP flist = flist     opT ADD flist = pairCompute (+) flist@@ -280,6 +282,8 @@ opGUnit oo@OoOp {} = gUnitOO $ BMiddle oo opGUnit oo@HpCodeCopy {} = gUnitOO $ BMiddle oo opGUnit oc@OcOp {} = gUnitOC $ BlockOC BNil oc+opGUnit oc@HpJump {} = gUnitOC $ BlockOC BNil oc+opGUnit oc@HpEnd {} = gUnitOC $ BlockOC BNil oc  -- catPElems :: [Pointed e x t] -> [t] -- catPElems = mapMaybe maybePElem@@ -307,6 +311,8 @@     ocR :: HplOp O C         -> StackNFact         -> WordLabelMapFuelM (Maybe (Graph HplOp O C))+    ocR op@HpJump {} _ = return (Just (opGUnit op))+    ocR op@HpEnd {} _ = return (Just (opGUnit op))     ocR op@(OcOp (loc, ope) ll) f =       case ope of         JUMP -> handleJmp@@ -340,57 +346,44 @@ doCfgAugWithTopNPass a = do   let disasmd = disasm a   contract <- evmOps2HplContract disasmd-  let entry_ = entryOf $ ctorOf contract-      body = bodyOf $ ctorOf contract-  case entry_ of-    Nothing -> return contract-    Just entry -> do-      newBody <-+  let body = ctorOf contract+  newBody <-+    runWithFuel+      10000000000+      ((\(h, _, _) -> h) <$>+       analyzeAndRewriteFwdOx+         cfgAugWithTopNPass+         body+         (fact_bot $ fp_lattice cfgAugWithTopNPass))+  let newHexstrings =+        foldGraphNodes+          (\n l ->+             case n of+               HpCodeCopy offset ->+                 let newhs =+                       EvmBytecode $+                       DB.drop (fromInteger (getBigWordInteger offset)) $+                       unEvmBytecode (evmBytecodeOf a)+                 in if DB.null $ unEvmBytecode newhs+                      then l+                      else l <> [newhs]+               _ -> l)+          newBody+          ([] :: [EvmBytecode])+  case newHexstrings of+    [] -> return contract {ctorOf = newBody}+    [newhs] -> do+      disBody <- evmOps2HplCfg $ disasm newhs+      newDisBody <-         runWithFuel           10000000000-          (fst <$>-           analyzeAndRewriteFwdBody+          ((\(h, _, _) -> h) <$>+           analyzeAndRewriteFwdOx              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 =-                           EvmBytecode $-                           DB.drop (fromInteger (getBigWordInteger offset)) $-                           unEvmBytecode (evmBytecodeOf a)-                     in if DB.null $ unEvmBytecode 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 $ disasm 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-            }-        _ ->-          panic $-          "doCfgAugWithTopNPass: unexpected newHexstrings length: " <>-          toS (show (DL.length newHexstrings))+             disBody+             (fact_bot $ fp_lattice cfgAugWithTopNPass))+      return HplContract {ctorOf = newBody, dispatcherOf = newDisBody}+    _ ->+      panic $+      "doCfgAugWithTopNPass: unexpected newHexstrings length: " <>+      toS (show (DL.length newHexstrings))

@@ -56,6 +56,8 @@     ooT (HpCodeCopy _) f = f     ocT :: HplOp O C -> StackTopFact -> FactBase StackTopFact     ocT hplop@(OcOp (_, op) _) f = distributeFact hplop (opT op f)+    ocT hplop@(HpJump _ _) f = distributeFact hplop f+    ocT hplop@(HpEnd _) f = distributeFact hplop f     opT :: Operation -> StackTopFact -> StackTopFact     opT DUP1 f = f     opT ISZERO (PElem st) =@@ -87,6 +89,8 @@ opGUnit oo@OoOp {} = gUnitOO $ BMiddle oo opGUnit oo@HpCodeCopy {} = gUnitOO $ BMiddle oo opGUnit oc@OcOp {} = gUnitOC $ BlockOC BNil oc+opGUnit oc@HpJump {} = gUnitOC $ BlockOC BNil oc+opGUnit oc@HpEnd {} = gUnitOC $ BlockOC BNil oc  cfgAugmentRewrite :: FwdRewrite WordLabelMapFuelM HplOp StackTopFact cfgAugmentRewrite = mkFRewrite3 coR ooR ocR@@ -102,6 +106,8 @@     ocR :: HplOp O C         -> StackTopFact         -> WordLabelMapFuelM (Maybe (Graph HplOp O C))+    ocR op@HpJump {} _ = return (Just (opGUnit op))+    ocR op@HpEnd {} _ = return (Just (opGUnit op))     ocR op@(OcOp (loc, ope) ll) f =       case ope of         JUMP -> handleJmp@@ -127,19 +133,10 @@   }  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}+doCfgAugmentPass contract = do+  let body = ctorOf contract+  newBody <-+    runWithFuel+      1000000+      ((\(a, _, _) -> a) <$> analyzeAndRewriteFwdOx cfgAugmentPass body Top)+  return contract {ctorOf = newBody}

@@ -3,14 +3,13 @@   TypeFamilies, ScopedTypeVariables, UndecidableInstances #-}  module Ethereum.Analyzer.EVM.IR-  ( HplBody-  , HplCode(..)+  ( HplCfg   , HplContract(..)   , HplOp(..)   , WordLabelMapM   , WordLabelMapFuelM   , unWordLabelMapM-  , evmOps2HplCode+  , evmOps2HplCfg   , evmOps2HplContract   , labelFor   , labelsFor@@ -34,10 +33,16 @@ import GHC.Show import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord +newtype MyLabel = MyLabel+  { unMyLabel :: Label+  } deriving (Eq)+ data HplOp e x where         CoOp :: Label -> HplOp C O         OoOp :: (Word256, Operation) -> HplOp O O         OcOp :: (Word256, Operation) -> [Label] -> HplOp O C+        HpJump :: MyLabel -> Label -> HplOp O C+        HpEnd :: MyLabel -> HplOp O C         HpCodeCopy :: Word256 -> HplOp O O  showLoc :: Word256 -> String@@ -53,6 +58,8 @@   show (CoOp l) = "CO: " <> show l   show (OoOp op) = "OO: " <> showOp op   show (OcOp op ll) = "OC: " <> showOp op <> " -> " <> show ll+  show (HpJump _ l) = "OC: HpJump -> " <> show l+  show HpEnd {} = "OC: HpEnd"   show (HpCodeCopy offset) = "HpCodeCopy " <> show offset  instance Show (Block HplOp C C) where@@ -70,71 +77,73 @@  instance Eq (HplOp O C) where   (==) (OcOp a _) (OcOp b _) = a == b+  (==) (HpJump l1 _) (HpJump l2 _) = l1 == l2+  (==) (HpEnd l1) (HpEnd l2) = l1 == l2+  (==) _ _ = False  instance NonLocal HplOp where   entryLabel (CoOp l) = l   successors (OcOp _ ll) = ll+  successors (HpJump _ ll) = [ll]+  successors (HpEnd _) = [] -type HplBody = Body HplOp+type HplCfg = Graph HplOp O C -data HplCode = HplCode-  { entryOf :: Maybe Label-  , bodyOf :: HplBody-  } deriving (Show)+instance Show HplCfg where+  show = showGraph show  data HplContract = HplContract-  { ctorOf :: HplCode-  , dispatcherOf :: HplCode+  { ctorOf :: HplCfg+  , dispatcherOf :: HplCfg   } deriving (Show) -emptyCode :: HplCode-emptyCode = HplCode Nothing emptyBody+emptyHplCfg+  :: UniqueMonad m+  => m HplCfg+emptyHplCfg = do+  l <- myFreshLabel+  return $ mkLast (HpEnd l)  evmOps2HplContract :: [(Word256, Operation)] -> WordLabelMapM HplContract evmOps2HplContract l = do-  ctorBody <- evmOps2HplCode l-  return HplContract {ctorOf = ctorBody, dispatcherOf = emptyCode}+  ctorBody <- evmOps2HplCfg l+  ec <- emptyHplCfg+  return HplContract {ctorOf = ctorBody, dispatcherOf = ec} -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}+myFreshLabel+  :: UniqueMonad m+  => m MyLabel+myFreshLabel = fmap MyLabel freshLabel -_evmOps2HplBody :: [(Word256, Operation)] -> WordLabelMapM HplBody-_evmOps2HplBody [] = return emptyBody-_evmOps2HplBody el@((loc, _):_) = do+evmOps2HplCfg :: [(Word256, Operation)] -> WordLabelMapM HplCfg+evmOps2HplCfg [] = emptyHplCfg+evmOps2HplCfg el@((loc, _):_) = do   l <- labelFor loc-  doEvmOps2HplBody emptyBody (blockJoinHead (CoOp l) emptyBlock) el+  jpLabel <- myFreshLabel+  doEvmOps2HplCfg (mkLast $ HpJump jpLabel l) (mkFirst $ CoOp l) el   where-    doEvmOps2HplBody-      :: HplBody-      -> Block HplOp C O-      -> [(Word256, Operation)]-      -> WordLabelMapM HplBody-    doEvmOps2HplBody body _ [] = return body -- sliently discarding bad hds-    doEvmOps2HplBody body hd [h'] =+    doEvmOps2HplCfg :: HplCfg+                    -> Graph HplOp C O+                    -> [(Word256, Operation)]+                    -> WordLabelMapM HplCfg+    doEvmOps2HplCfg body _ [] = return body -- sliently discarding bad hds+    doEvmOps2HplCfg 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'):_)))+        then return $ body |*><*| hd CH.<*> mkLast (OcOp h' [])+        else return body -- sliently discarding bad hds+    doEvmOps2HplCfg body hd (h':(t'@((loc', op'):_)))       | isTerminator (snd h') = do         l' <- labelFor loc'-        doEvmOps2HplBody-          (addBlock-             (blockJoinTail hd (OcOp h' [l' | canPassThrough (snd h')]))-             body)-          (blockJoinHead (CoOp l') emptyBlock)+        doEvmOps2HplCfg+          (body |*><*| hd CH.<*> mkLast (OcOp h' [l' | canPassThrough (snd h')]))+          (mkFirst $ CoOp l')           t'-      | op' /= JUMPDEST = doEvmOps2HplBody body (blockSnoc hd (OoOp h')) t'+      | op' /= JUMPDEST = doEvmOps2HplCfg body (hd CH.<*> mkMiddle (OoOp h')) t'       | otherwise = do         l' <- labelFor loc'-        doEvmOps2HplBody-          (addBlock-             (blockJoinTail hd (OcOp h' [l' | canPassThrough (snd h')]))-             body)-          (blockJoinHead (CoOp l') emptyBlock)+        doEvmOps2HplCfg+          (body |*><*| hd CH.<*> mkLast (OcOp h' [l' | canPassThrough (snd h')]))+          (mkFirst $ CoOp l')           t'  isTerminator :: Operation -> Bool@@ -181,6 +190,13 @@           _ <- CH.restart suCheckpoint           return (m, ())     in WordLabelMapM mapper++instance UniqueMonad WordLabelMapM where+  freshUnique = WordLabelMapM f+    where+      f m = do+        u <- freshUnique+        return (m, u)  type WordLabelMapFuelM = CheckingFuelMonad WordLabelMapM 

@@ -3,25 +3,17 @@   #-}  module Ethereum.Analyzer.EVM.Util-  ( toDotText-  , disasmToDotText+  ( disasmToDotText   , disasmToDotText2   ) where  import Protolude hiding (show) -import Compiler.Hoopl-import Data.Graph.Inductive.Graph as DGIG-import Data.Graph.Inductive.PatriciaTree-import Data.GraphViz-import Data.GraphViz.Printing hiding ((<>))-import qualified Data.Text.Lazy as DTL import Ethereum.Analyzer.EVM.CfgAugWithTopNPass import Ethereum.Analyzer.EVM.CfgAugmentPass import Ethereum.Analyzer.EVM.Disasm import Ethereum.Analyzer.EVM.IR-import GHC.Show-import Text.Read (read)+import Ethereum.Analyzer.Util  disasmToDotText   :: HasEvmBytecode a@@ -31,7 +23,7 @@       result =         unWordLabelMapM $ do           contract <- evmOps2HplContract disasmd-          toDotText <$> (bodyOf . ctorOf <$> doCfgAugmentPass contract)+          toDotText <$> (ctorOf <$> doCfgAugmentPass contract)   in result  disasmToDotText2@@ -42,36 +34,5 @@         unWordLabelMapM $ do           contract' <- doCfgAugWithTopNPass a           return-            ( toDotText $ bodyOf (ctorOf contract')-            , toDotText $ bodyOf (dispatcherOf contract'))+            (toDotText (ctorOf contract'), toDotText (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 (drop 1 $ toS $ show l)-      (nList, eList) =-        mapFoldWithKey-          (\lbl blk (nList', eList') ->-             let node = lblToNode lbl-                 edgs = map (\l -> (node, lblToNode l, ())) (successors blk)-             in (nList' <> [(node, blk)], eList' <> edgs))-          ([], [])-          bd-  in mkGraph nList eList--visParams-  :: forall n el.-     GraphvizParams n (Block HplOp C C) el () (Block HplOp C C)-visParams =-  nonClusteredParams-  {fmtNode = \(_, nl) -> [textLabel (toS $ show nl), shape BoxShape]}--toDotGraph :: Gr (Block HplOp C C) () -> DotGraph Node-toDotGraph = graphToDot visParams

@@ -2,10 +2,12 @@   ( module Ethereum.Analyzer.Solidity.AstJson   , module Ethereum.Analyzer.Solidity.Finding   , module Ethereum.Analyzer.Solidity.Foreach+  , module Ethereum.Analyzer.Solidity.Hoople   , module Ethereum.Analyzer.Solidity.Simple   ) where  import Ethereum.Analyzer.Solidity.AstJson import Ethereum.Analyzer.Solidity.Finding import Ethereum.Analyzer.Solidity.Foreach+import Ethereum.Analyzer.Solidity.Hoople import Ethereum.Analyzer.Solidity.Simple

@@ -13,8 +13,8 @@ selfdestruct :: Contract -> [Text] selfdestruct c = concatMap sdExp $ expressionsOf c   where-    sdExp exp =-      case exp of+    sdExp e =+      case e of         ExpCall (JustId (Idfr "suicide")) _ ->           ["Prefer 'selfdestruct' over 'suicide'."]         _ -> []

@@ -33,7 +33,7 @@ _eOf :: Statement -> [Expression] _eOf (StLocalVarDecl _) = [] _eOf (StAssign _ e) = [e]-_eOf (StIf{}) = []+_eOf StIf {} = [] _eOf (StLoop _) = [] _eOf StBreak = [] _eOf StContinue = []

@@ -0,0 +1,107 @@+{-# LANGUAGE GADTs #-}++module Ethereum.Analyzer.Solidity.Hoople+  ( hoopleOf+  , HContract(..)+  , HFunDefinition(..)+  ) where++import Protolude hiding ((<*>))++import Compiler.Hoopl+import Ethereum.Analyzer.Solidity.Simple++data HContract = HContract+  { hcName :: Text+  , hcStateVars :: [VarDecl]+  , hcFunctions :: [HFunDefinition]+  }++type CFG = Graph HStatement O C++type ACFG = AGraph HStatement O C++data HFunDefinition = HFunDefinition+  { hfName :: Idfr+  , hfParams :: [VarDecl]+  , hfReturns :: [VarDecl]+  , hfCFG :: CFG+  }++data HStatement e x where+        CoSt :: Label -> HStatement C O+        OoSt :: Statement -> HStatement O O+        OcSt :: Statement -> [Label] -> HStatement O C+        OcJump :: Label -> HStatement O C++instance NonLocal HStatement where+  entryLabel (CoSt lbl) = lbl+  successors (OcSt _ lbls) = lbls+  successors (OcJump lbl) = [lbl]++instance HooplNode HStatement where+  mkBranchNode = OcJump+  mkLabelNode = CoSt++hoopleOf+  :: UniqueMonad m+  => Contract -> m HContract+hoopleOf Contract {cName = name, cStateVars = vars, cFunctions = funs} = do+  hFuns <- mapM hfunOf funs+  return $ HContract name vars hFuns++hfunOf+  :: UniqueMonad m+  => FunDefinition -> m HFunDefinition+hfunOf FunDefinition { fName = name+                     , fParams = params+                     , fReturns = returns+                     , fBody = stmts+                     } = do+  entryL <- freshLabel+  exitL <- freshLabel+  stmtGraph <- graphOf stmts exitL entryL+  let acfg = (mkBranch entryL |*><*| mkLabel entryL <*> stmtGraph) :: ACFG+  cfg <- graphOfAGraph acfg+  return $ HFunDefinition name params returns cfg++graphOf+  :: UniqueMonad m+  => [Statement] -> Label -> Label -> m ACFG+graphOf [] exitL _ = return $ mkBranch exitL+graphOf (h:t) exitL loopL = do+  postDom <- graphOf t exitL loopL+  case h of+    StLocalVarDecl _ -> return $ mkMiddle' h <*> postDom+    StAssign _ _ -> return $ mkMiddle' h <*> postDom+    StDelete _ -> return $ mkMiddle' h <*> postDom+    StTodo _ -> return $ mkMiddle' h <*> postDom+    StReturn _ -> do+      pdL <- freshLabel+      return $ mkLast (OcSt h []) |*><*| (mkLabel pdL <*> postDom)+    StThrow -> do+      pdL <- freshLabel+      return $ mkLast (OcSt h []) |*><*| (mkLabel pdL <*> postDom)+    StIf _ thenSts elseSts -> do+      pdL <- freshLabel+      thenG <- graphOf thenSts pdL loopL+      elseG <- graphOf elseSts pdL loopL+      -- TODO(zchn): remove the then and else statements in h when+      -- constructing OcSt.+      let ifte =+            mkIfThenElse+              (\thenLbl elseLbl -> mkLast (OcSt h [thenLbl, elseLbl]))+              thenG+              elseG+      return $ ifte |*><*| (mkLabel pdL <*> postDom)+    StLoop stmts -> do+      pdL <- freshLabel+      bodyLbl <- freshLabel+      bodyG <- graphOf stmts pdL bodyLbl+      return $+        mkBranch bodyLbl |*><*| (mkLabel bodyLbl <*> bodyG) |*><*|+        (mkLabel pdL <*> postDom)+    StBreak -> return $ mkBranch exitL+    StContinue -> return $ mkBranch loopL+  where+    mkMiddle' a = mkMiddle (OoSt a)

@@ -196,11 +196,11 @@   return     [StAssign newidfr $ ExpLiteral "1", StAssign idfr $ ExpBin "+" idfr newidfr] s2sStatements SolNode { name = Just "UnaryOperation"-                        , children = Just [SolNode { name = Just "Identifier"-                                                   , attributes = Just SolNode {value = Just idName}-                                                   }]-                        , attributes = Just SolNode {operator = Just "--"}-                        } = do+                      , 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

@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs,+  NoImplicitPrelude, Rank2Types, TypeFamilies, UndecidableInstances+  #-}++module Ethereum.Analyzer.Util+  ( toDotText+  ) where++import Protolude hiding (show)++import Compiler.Hoopl as CH+import Data.Graph.Inductive.Graph as DGIG+import Data.Graph.Inductive.PatriciaTree+import Data.GraphViz+import Data.GraphViz.Printing hiding ((<>))+import qualified Data.Text.Lazy as DTL+import GHC.Show+import Text.Read (read)++toDotText+  :: (NonLocal n, Show (Block n C C))+  => CH.Graph n O C -> Text+toDotText bd =+  let bdGr = toGr bd+      dotG = toDotGraph bdGr+      dotCode = toDot dotG+  in DTL.toStrict $ renderDot dotCode++toGr+  :: NonLocal n+  => CH.Graph n O C -> Gr (Block n C C) ()+toGr bd =+  let lblToNode l = read (drop 1 $ toS $ show l)+      blocks = postorder_dfs bd+      (nList, eList) =+        foldr+          (\blk (nList', eList') ->+             let node = lblToNode $ entryLabel blk+                 edgs = map (\l -> (node, lblToNode l, ())) (successors blk)+             in (nList' <> [(node, blk)], eList' <> edgs))+          ([], [])+          blocks+  in mkGraph nList eList++visParams+  :: (Show (Block n C C))+  => GraphvizParams p (Block n C C) el () (Block n C C)+visParams =+  nonClusteredParams+  {fmtNode = \(_, nl) -> [textLabel (toS $ show nl), shape BoxShape]}++toDotGraph+  :: (Show (Block n C C))+  => Gr (Block n C C) () -> DotGraph Node+toDotGraph = graphToDot visParams

@@ -19,10 +19,10 @@     it "works for hexstring1" $ do       let result =             unWordLabelMapM $ toS . show <$> doCfgAugWithTopNPass hexstring1-      DT.length result `shouldBe` 4815+      DT.length result `shouldBe` 4634     it "works for hexstring2" $ do       let result =             toS $             unWordLabelMapM               ((toS . show <$> doCfgAugWithTopNPass hexstring2) :: WordLabelMapM Text)-      (result :: [Char]) `shouldContain` "OC: 9: JUMPI -> [L2,L4]"+      (result :: [Char]) `shouldContain` "OC: 9: JUMPI -> [L3,L5]"

@@ -21,25 +21,25 @@             unWordLabelMapM $ do               contract <- evmOps2HplContract disasmd               (toS . show <$> doCfgAugmentPass contract) :: WordLabelMapM Text-      Data.Text.length result `shouldBe` 4769+      Data.Text.length result `shouldBe` 4588     it "works for hexstring2" $ do       let disasmd@((_, _):_) = disasm hexstring2           result =             unWordLabelMapM $ do               contract <- evmOps2HplContract disasmd-              toS . show . bodyOf . ctorOf <$> doCfgAugmentPass contract+              toS . show . ctorOf <$> doCfgAugmentPass contract       result `shouldBe` expectedHexString2CtorBody  expectedHexString2CtorBody :: Text expectedHexString2CtorBody =-  "LM (UM (fromList [(1,CO: L1\n" <> "OO: 0: PUSH [96]\n" <>+  "OC: HpJump -> L1\n" <> "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" <>+  "OC: 9: JUMPI -> [L3,L5]\n" <>+  "CO: L3\n" <>   "OO: 10: PUSH [224]\n" <>   "OO: 12: PUSH [2]\n" <>   "OO: 14: EXP\n" <>@@ -50,14 +50,14 @@   "OO: 24: DUP2\n" <>   "OO: 25: EQ\n" <>   "OO: 26: PUSH [110]\n" <>-  "OC: 28: JUMPI -> [L3,L7]\n" <>-  "),(3,CO: L3\n" <>+  "OC: 28: JUMPI -> [L4,L8]\n" <>+  "CO: L4\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" <>+  "OC: 38: JUMPI -> [L5,L10]\n" <>+  "CO: L5\n" <>   "OO: 39: JUMPDEST\n" <>   "OO: 40: PUSH [213]\n" <>   "OO: 42: PUSH [0]\n" <>@@ -65,8 +65,8 @@   "OO: 45: GT\n" <>   "OO: 46: ISZERO\n" <>   "OO: 47: PUSH [108]\n" <>-  "OC: 49: JUMPI -> [L5,L6]\n" <>-  "),(5,CO: L5\n" <>+  "OC: 49: JUMPI -> [L6,L7]\n" <>+  "CO: L6\n" <>   "OO: 50: CALLVALUE\n" <>   "OO: 51: PUSH [96]\n" <>   "OO: 53: SWAP1\n" <>@@ -86,11 +86,11 @@   "OO: 103: SWAP1\n" <>   "OO: 104: PUSH [32]\n" <>   "OO: 106: SWAP1\n" <>-  "OC: 107: LOG3 -> [L6]\n" <>-  "),(6,CO: L6\n" <>+  "OC: 107: LOG3 -> [L7]\n" <>+  "CO: L7\n" <>   "OO: 108: JUMPDEST\n" <>   "OC: 109: JUMP -> []\n" <>-  "),(7,CO: L7\n" <>+  "CO: L8\n" <>   "OO: 110: JUMPDEST\n" <>   "OO: 111: PUSH [213]\n" <>   "OO: 113: PUSH [0]\n" <>@@ -111,8 +111,8 @@   "OO: 132: EQ\n" <>   "OO: 133: ISZERO\n" <>   "OO: 134: PUSH [108]\n" <>-  "OC: 136: JUMPI -> [L6,L8]\n" <>-  "),(8,CO: L8\n" <>+  "OC: 136: JUMPI -> [L7,L9]\n" <>+  "CO: L9\n" <>   "OO: 137: PUSH [0]\n" <>   "OO: 139: SLOAD\n" <>   "OO: 140: PUSH [1]\n" <>@@ -122,7 +122,7 @@   "OO: 147: SUB\n" <>   "OO: 148: AND\n" <>   "OC: 149: SUICIDE -> []\n" <>-  "),(9,CO: L9\n" <>+  "CO: L10\n" <>   "OO: 150: JUMPDEST\n" <>   "OO: 151: PUSH [213]\n" <>   "OO: 153: PUSH [0]\n" <>@@ -143,8 +143,8 @@   "OO: 172: EQ\n" <>   "OO: 173: ISZERO\n" <>   "OO: 174: PUSH [108]\n" <>-  "OC: 176: JUMPI -> [L6,L10]\n" <>-  "),(10,CO: L10\n" <>+  "OC: 176: JUMPI -> [L7,L11]\n" <>+  "CO: L11\n" <>   "OO: 177: PUSH [0]\n" <>   "OO: 179: DUP1\n" <>   "OO: 180: SLOAD\n" <>@@ -169,12 +169,11 @@   "OO: 203: DUP6\n" <>   "OO: 204: DUP9\n" <>   "OO: 205: DUP4\n" <>-  "OC: 206: CALL -> [L11]\n" <>-  "),(11,CO: L11\n" <>+  "OC: 206: CALL -> [L12]\n" <>+  "CO: L12\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" <>-  ")]))"+  "OC: 212: JUMP -> []\n"

@@ -15,31 +15,33 @@   describe "e2h" $ do     it "works for hexstring1" $ do       let disasmd = disasm hexstring1-      unWordLabelMapM (mapSize . bodyOf . ctorOf <$> evmOps2HplContract disasmd) `shouldBe`-        327+      unWordLabelMapM+        (setSize . labelsUsed . ctorOf <$> evmOps2HplContract disasmd) `shouldBe`+        189     it "works for hexstring2" $ do       let disasmd = disasm hexstring2-      unWordLabelMapM (mapSize . bodyOf . ctorOf <$> evmOps2HplContract disasmd) `shouldBe`-        12+      unWordLabelMapM+        (setSize . labelsUsed . ctorOf <$> evmOps2HplContract disasmd) `shouldBe`+        9      -- it "shows voteHexstring" $      --   do let disasmd = disasm voteHexstring-     --      unWordLabelMapM (show <$> (evmOps2HplBody disasmd)) `shouldBe` ""-    it "shows HplBody" $ do+     --      unWordLabelMapM (show <$> (evmOps2HplCfg disasmd)) `shouldBe` ""+    it "shows HplCfg" $ do       let disasmd = disasm hexstring2       unWordLabelMapM-        ((toS . show . bodyOf . ctorOf <$> evmOps2HplContract disasmd) :: WordLabelMapM Text) `shouldBe`+        ((toS . show . ctorOf <$> evmOps2HplContract disasmd) :: WordLabelMapM Text) `shouldBe`         toS expectedHexString2CtorBody  expectedHexString2CtorBody :: Text expectedHexString2CtorBody =-  "LM (UM (fromList [(1,CO: L1\n" <> "OO: 0: PUSH [96]\n" <>+  "OC: HpJump -> L1\n" <> "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" <>+  "OC: 9: JUMPI -> [L3]\n" <>+  "CO: L3\n" <>   "OO: 10: PUSH [224]\n" <>   "OO: 12: PUSH [2]\n" <>   "OO: 14: EXP\n" <>@@ -50,14 +52,14 @@   "OO: 24: DUP2\n" <>   "OO: 25: EQ\n" <>   "OO: 26: PUSH [110]\n" <>-  "OC: 28: JUMPI -> [L3]\n" <>-  "),(3,CO: L3\n" <>+  "OC: 28: JUMPI -> [L4]\n" <>+  "CO: L4\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" <>+  "OC: 38: JUMPI -> [L5]\n" <>+  "CO: L5\n" <>   "OO: 39: JUMPDEST\n" <>   "OO: 40: PUSH [213]\n" <>   "OO: 42: PUSH [0]\n" <>@@ -65,8 +67,8 @@   "OO: 45: GT\n" <>   "OO: 46: ISZERO\n" <>   "OO: 47: PUSH [108]\n" <>-  "OC: 49: JUMPI -> [L5]\n" <>-  "),(5,CO: L5\n" <>+  "OC: 49: JUMPI -> [L6]\n" <>+  "CO: L6\n" <>   "OO: 50: CALLVALUE\n" <>   "OO: 51: PUSH [96]\n" <>   "OO: 53: SWAP1\n" <>@@ -86,11 +88,11 @@   "OO: 103: SWAP1\n" <>   "OO: 104: PUSH [32]\n" <>   "OO: 106: SWAP1\n" <>-  "OC: 107: LOG3 -> [L6]\n" <>-  "),(6,CO: L6\n" <>+  "OC: 107: LOG3 -> [L7]\n" <>+  "CO: L7\n" <>   "OO: 108: JUMPDEST\n" <>   "OC: 109: JUMP -> []\n" <>-  "),(7,CO: L7\n" <>+  "CO: L8\n" <>   "OO: 110: JUMPDEST\n" <>   "OO: 111: PUSH [213]\n" <>   "OO: 113: PUSH [0]\n" <>@@ -111,8 +113,8 @@   "OO: 132: EQ\n" <>   "OO: 133: ISZERO\n" <>   "OO: 134: PUSH [108]\n" <>-  "OC: 136: JUMPI -> [L8]\n" <>-  "),(8,CO: L8\n" <>+  "OC: 136: JUMPI -> [L9]\n" <>+  "CO: L9\n" <>   "OO: 137: PUSH [0]\n" <>   "OO: 139: SLOAD\n" <>   "OO: 140: PUSH [1]\n" <>@@ -122,7 +124,7 @@   "OO: 147: SUB\n" <>   "OO: 148: AND\n" <>   "OC: 149: SUICIDE -> []\n" <>-  "),(9,CO: L9\n" <>+  "CO: L10\n" <>   "OO: 150: JUMPDEST\n" <>   "OO: 151: PUSH [213]\n" <>   "OO: 153: PUSH [0]\n" <>@@ -143,8 +145,8 @@   "OO: 172: EQ\n" <>   "OO: 173: ISZERO\n" <>   "OO: 174: PUSH [108]\n" <>-  "OC: 176: JUMPI -> [L10]\n" <>-  "),(10,CO: L10\n" <>+  "OC: 176: JUMPI -> [L11]\n" <>+  "CO: L11\n" <>   "OO: 177: PUSH [0]\n" <>   "OO: 179: DUP1\n" <>   "OO: 180: SLOAD\n" <>@@ -169,15 +171,14 @@   "OO: 203: DUP6\n" <>   "OO: 204: DUP9\n" <>   "OO: 205: DUP4\n" <>-  "OC: 206: CALL -> [L11]\n" <>-  "),(11,CO: L11\n" <>+  "OC: 206: CALL -> [L12]\n" <>+  "CO: L12\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" <>+  "CO: L13\n" <>   "OO: 213: JUMPDEST\n" <>-  "OC: 214: STOP -> []\n" <>-  ")]))"+  "OC: 214: STOP -> []\n"

@@ -9,24 +9,26 @@ import Data.Text import Ethereum.Analyzer.EVM import Ethereum.Analyzer.TestData.Basic+import Ethereum.Analyzer.Util import Test.Hspec  spec :: Spec spec =   describe "toDotText" $ do-    it "shows HplBody's dot graph" $ do+    it "shows HplCfg's dot graph" $ do       let disasmd = disasm hexstring2       (unpack . unWordLabelMapM)-        (toDotText . bodyOf . ctorOf <$> evmOps2HplContract disasmd) `shouldBe`+        (toDotText . ctorOf <$> evmOps2HplContract disasmd) `shouldBe`         toS expectedHexString2RawDot-    it "shows HplBody after CfgAugmentPass" $ do+    it "shows HplCfg after CfgAugmentPass" $ do       let disasmd@((_, _):_) = disasm hexstring2           result =             (unpack . unWordLabelMapM) $ do               contract <- evmOps2HplContract disasmd-              toDotText . bodyOf . ctorOf <$> doCfgAugmentPass contract+              toDotText . ctorOf <$> doCfgAugmentPass contract       result `shouldBe` toS expectedHexString2AugDot +-- There are more opcode in the hexstring than printed here. expectedHexString2RawDot :: Text expectedHexString2RawDot =   "digraph {\n" <> "    1 [label=\"CO: L1\\n" <> "OO: 0: PUSH [96]\\n" <>@@ -35,10 +37,10 @@   "OO: 5: CALLDATASIZE\\n" <>   "OO: 6: ISZERO\\n" <>   "OO: 7: PUSH [39]\\n" <>-  "OC: 9: JUMPI -> [L2]\\n" <>+  "OC: 9: JUMPI -> [L3]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    2 [label=\"CO: L2\\n" <>+  "    3 [label=\"CO: L3\\n" <>   "OO: 10: PUSH [224]\\n" <>   "OO: 12: PUSH [2]\\n" <>   "OO: 14: EXP\\n" <>@@ -49,18 +51,18 @@   "OO: 24: DUP2\\n" <>   "OO: 25: EQ\\n" <>   "OO: 26: PUSH [110]\\n" <>-  "OC: 28: JUMPI -> [L3]\\n" <>+  "OC: 28: JUMPI -> [L4]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    3 [label=\"CO: L3\\n" <>+  "    4 [label=\"CO: L4\\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" <>+  "OC: 38: JUMPI -> [L5]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    4 [label=\"CO: L4\\n" <>+  "    5 [label=\"CO: L5\\n" <>   "OO: 39: JUMPDEST\\n" <>   "OO: 40: PUSH [213]\\n" <>   "OO: 42: PUSH [0]\\n" <>@@ -68,10 +70,10 @@   "OO: 45: GT\\n" <>   "OO: 46: ISZERO\\n" <>   "OO: 47: PUSH [108]\\n" <>-  "OC: 49: JUMPI -> [L5]\\n" <>+  "OC: 49: JUMPI -> [L6]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    5 [label=\"CO: L5\\n" <>+  "    6 [label=\"CO: L6\\n" <>   "OO: 50: CALLVALUE\\n" <>   "OO: 51: PUSH [96]\\n" <>   "OO: 53: SWAP1\\n" <>@@ -91,124 +93,19 @@   "OO: 103: SWAP1\\n" <>   "OO: 104: PUSH [32]\\n" <>   "OO: 106: SWAP1\\n" <>-  "OC: 107: LOG3 -> [L6]\\n" <>+  "OC: 107: LOG3 -> [L7]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    6 [label=\"CO: L6\\n" <>+  "    7 [label=\"CO: L7\\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" <>+  "    1 -> 3;\n" <>   "    3 -> 4;\n" <>   "    4 -> 5;\n" <>   "    5 -> 6;\n" <>-  "    7 -> 8;\n" <>-  "    9 -> 10;\n" <>-  "    10 -> 11;\n" <>+  "    6 -> 7;\n" <>   "}"  expectedHexString2AugDot :: Text@@ -219,10 +116,10 @@   "OO: 5: CALLDATASIZE\\n" <>   "OO: 6: ISZERO\\n" <>   "OO: 7: PUSH [39]\\n" <>-  "OC: 9: JUMPI -> [L2,L4]\\n" <>+  "OC: 9: JUMPI -> [L3,L5]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    2 [label=\"CO: L2\\n" <>+  "    3 [label=\"CO: L3\\n" <>   "OO: 10: PUSH [224]\\n" <>   "OO: 12: PUSH [2]\\n" <>   "OO: 14: EXP\\n" <>@@ -233,18 +130,18 @@   "OO: 24: DUP2\\n" <>   "OO: 25: EQ\\n" <>   "OO: 26: PUSH [110]\\n" <>-  "OC: 28: JUMPI -> [L3,L7]\\n" <>+  "OC: 28: JUMPI -> [L4,L8]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    3 [label=\"CO: L3\\n" <>+  "    4 [label=\"CO: L4\\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" <>+  "OC: 38: JUMPI -> [L5,L10]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    4 [label=\"CO: L4\\n" <>+  "    5 [label=\"CO: L5\\n" <>   "OO: 39: JUMPDEST\\n" <>   "OO: 40: PUSH [213]\\n" <>   "OO: 42: PUSH [0]\\n" <>@@ -252,10 +149,10 @@   "OO: 45: GT\\n" <>   "OO: 46: ISZERO\\n" <>   "OO: 47: PUSH [108]\\n" <>-  "OC: 49: JUMPI -> [L5,L6]\\n" <>+  "OC: 49: JUMPI -> [L6,L7]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    5 [label=\"CO: L5\\n" <>+  "    6 [label=\"CO: L6\\n" <>   "OO: 50: CALLVALUE\\n" <>   "OO: 51: PUSH [96]\\n" <>   "OO: 53: SWAP1\\n" <>@@ -275,15 +172,15 @@   "OO: 103: SWAP1\\n" <>   "OO: 104: PUSH [32]\\n" <>   "OO: 106: SWAP1\\n" <>-  "OC: 107: LOG3 -> [L6]\\n" <>+  "OC: 107: LOG3 -> [L7]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    6 [label=\"CO: L6\\n" <>+  "    7 [label=\"CO: L7\\n" <>   "OO: 108: JUMPDEST\\n" <>   "OC: 109: JUMP -> []\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    7 [label=\"CO: L7\\n" <>+  "    8 [label=\"CO: L8\\n" <>   "OO: 110: JUMPDEST\\n" <>   "OO: 111: PUSH [213]\\n" <>   "OO: 113: PUSH [0]\\n" <>@@ -304,10 +201,10 @@   "OO: 132: EQ\\n" <>   "OO: 133: ISZERO\\n" <>   "OO: 134: PUSH [108]\\n" <>-  "OC: 136: JUMPI -> [L6,L8]\\n" <>+  "OC: 136: JUMPI -> [L7,L9]\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    8 [label=\"CO: L8\\n" <>+  "    9 [label=\"CO: L9\\n" <>   "OO: 137: PUSH [0]\\n" <>   "OO: 139: SLOAD\\n" <>   "OO: 140: PUSH [1]\\n" <>@@ -319,7 +216,7 @@   "OC: 149: SUICIDE -> []\\n" <>   "\"\n" <>   "      ,shape=box];\n" <>-  "    9 [label=\"CO: L9\\n" <>+  "    10 [label=\"CO: L10\\n" <>   "OO: 150: JUMPDEST\\n" <>   "OO: 151: PUSH [213]\\n" <>   "OO: 153: PUSH [0]\\n" <>@@ -340,10 +237,10 @@   "OO: 172: EQ\\n" <>   "OO: 173: ISZERO\\n" <>   "OO: 174: PUSH [108]\\n" <>-  "OC: 176: JUMPI -> [L6,L10]\\n" <>+  "OC: 176: JUMPI -> [L7,L11]\\n" <>   "\"\n" <>-  "      ,shape=box];\n" <>-  "    10 [label=\"CO: L10\\n" <>+  "       ,shape=box];\n" <>+  "    11 [label=\"CO: L11\\n" <>   "OO: 177: PUSH [0]\\n" <>   "OO: 179: DUP1\\n" <>   "OO: 180: SLOAD\\n" <>@@ -368,10 +265,10 @@   "OO: 203: DUP6\\n" <>   "OO: 204: DUP9\\n" <>   "OO: 205: DUP4\\n" <>-  "OC: 206: CALL -> [L11]\\n" <>+  "OC: 206: CALL -> [L12]\\n" <>   "\"\n" <>   "       ,shape=box];\n" <>-  "    11 [label=\"CO: L11\\n" <>+  "    12 [label=\"CO: L12\\n" <>   "OO: 207: POP\\n" <>   "OO: 208: POP\\n" <>   "OO: 209: POP\\n" <>@@ -380,18 +277,18 @@   "OC: 212: JUMP -> []\\n" <>   "\"\n" <>   "       ,shape=box];\n" <>-  "    1 -> 2;\n" <>-  "    1 -> 4;\n" <>-  "    2 -> 3;\n" <>-  "    2 -> 7;\n" <>+  "    1 -> 3;\n" <>+  "    1 -> 5;\n" <>   "    3 -> 4;\n" <>-  "    3 -> 9;\n" <>+  "    3 -> 8;\n" <>   "    4 -> 5;\n" <>-  "    4 -> 6;\n" <>+  "    4 -> 10;\n" <>   "    5 -> 6;\n" <>-  "    7 -> 6;\n" <>-  "    7 -> 8;\n" <>-  "    9 -> 6;\n" <>-  "    9 -> 10;\n" <>+  "    5 -> 7;\n" <>+  "    6 -> 7;\n" <>+  "    8 -> 7;\n" <>+  "    8 -> 9;\n" <>+  "    10 -> 7;\n" <>   "    10 -> 11;\n" <>+  "    11 -> 12;\n" <>   "}"

@@ -11,13 +11,13 @@ spec :: Spec spec = do   describe "statementsOf" $-    it "works for storageJson" $ do+    it "works for storageJson" $     case decodeContracts storageJson of       Right contracts ->         sum (map (length . statementsOf) contracts) `shouldBe` 2       Left err -> expectationFailure $ toS err   describe "expressionsOf" $-    it "works for storageJson" $ do+    it "works for storageJson" $     case decodeContracts storageJson of       Right contracts ->         sum (map (length . expressionsOf) contracts) `shouldBe` 1

@@ -0,0 +1,32 @@+module Ethereum.Analyzer.Solidity.HoopleSpec+  ( spec+  ) where++import Protolude hiding (show)++import Compiler.Hoopl++import Ethereum.Analyzer.Solidity+import Ethereum.Analyzer.TestData.Asts+import GHC.Show (Show(..))++import Test.Hspec++spec :: Spec+spec = describe "hoopleOf" $ mapM_ hoopleOfWorks testFilepaths++hoopleOfWorks :: Text -> SpecWith ()+hoopleOfWorks filepath =+  context (toS filepath) $+  it "converts Contract to HContract" $ do+    cfgs -- IO+       <-+      do solNodes <- solNodesOf filepath+         return $+           runSimpleUniqueMonad $ -- UniqueMonad+            do+             contracts <- concat <$> mapM s2sContracts solNodes+             hContracts <- mapM hoopleOf contracts+             return $ map hfCFG $ concatMap hcFunctions hContracts+    sum (map (\g -> foldGraphNodes (const (1 +)) g 0) cfgs) `shouldSatisfy`+      (> 0)

@@ -19,40 +19,40 @@ spec = do   describe "e2h" $     it "parses storageJson" $ do-    let eitherContracts = do-          solNodes <- decodeSoleNodes (toS storageJson)-          let mContracts = mapM s2sContracts solNodes-          let contracts = concat $ runSimpleUniqueMonad mContracts-          return contracts+      let eitherContracts = do+            solNodes <- decodeSoleNodes (toS storageJson)+            let mContracts = mapM s2sContracts solNodes+            let contracts = concat $ runSimpleUniqueMonad mContracts+            return contracts     -- GP.pp eitherContracts-    eitherContracts `shouldBe`-      Right-        [ Contract-          { cName = "SimpleStorage"-          , cStateVars =-              [VarDecl {vName = Idfr "storedData", vType = Unknown "uint256"}]-          , cFunctions =-              [ FunDefinition-                { fName = Idfr "set"-                , fParams =-                    [VarDecl {vName = Idfr "x", vType = Unknown "uint256"}]-                , fReturns = []-                , fBody =-                    [ StAssign-                        (JustId (Idfr "storedData"))-                        (ExpLval (JustId (Idfr "x")))-                    ]-                }-              , FunDefinition-                { fName = Idfr "get"-                , fParams = []-                , fReturns =-                    [VarDecl {vName = Idfr "", vType = Unknown "uint256"}]-                , fBody = [StReturn [JustId (Idfr "storedData")]]-                }-              ]-          }-        ]+      eitherContracts `shouldBe`+        Right+          [ Contract+            { cName = "SimpleStorage"+            , cStateVars =+                [VarDecl {vName = Idfr "storedData", vType = Unknown "uint256"}]+            , cFunctions =+                [ FunDefinition+                  { fName = Idfr "set"+                  , fParams =+                      [VarDecl {vName = Idfr "x", vType = Unknown "uint256"}]+                  , fReturns = []+                  , fBody =+                      [ StAssign+                          (JustId (Idfr "storedData"))+                          (ExpLval (JustId (Idfr "x")))+                      ]+                  }+                , FunDefinition+                  { fName = Idfr "get"+                  , fParams = []+                  , fReturns =+                      [VarDecl {vName = Idfr "", vType = Unknown "uint256"}]+                  , fBody = [StReturn [JustId (Idfr "storedData")]]+                  }+                ]+            }+          ]   describe "Simple" $ mapM_ nonEmptySimple testFilepaths  nonEmptySimple :: Text -> SpecWith ()