packages feed

ethereum-analyzer 0.0.1 → 1.0.0

raw patch · 35 files changed

+1833/−2627 lines, 35 filesdep −directory

Dependencies removed: directory

Files

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