ethereum-analyzer (empty) → 0.0.1

raw patch · 29 files changed

+2941/−0 lines, 29 filesdep +aesondep +basedep +bimapsetup-changed

Dependencies added: aeson, base, bimap, bytestring, conduit-combinators, conduit-extra, containers, directory, ethereum-analyzer, ethereum-analyzer-deps, exceptions, extra, fgl, graphviz, hexstring, hflags, hoopl, hspec, http-conduit, http-media, http-types, json-rpc, logging-effect, monad-logger, mtl, neat-interpolation, network, optparse-applicative, prometheus-client, prometheus-metrics-ghc, protolude, servant, servant-server, text, time, unordered-containers, vector, wai, wai-extra, wai-middleware-prometheus, warp, wl-pprint-text

Files

• ChangeLog.md +5/−0
• LICENSE +202/−0
• README.md +1/−0
• Setup.hs +3/−0
• ethereum-analyzer.cabal +131/−0
• exec_src/DumpCodeMain.hs +72/−0
• exec_src/Main.hs +9/−0
• src/Blockchain/Analyze.hs +11/−0
• src/Blockchain/Analyze/CfgAugWithTopNPass.hs +370/−0
• src/Blockchain/Analyze/CfgAugmentPass.hs +140/−0
• src/Blockchain/Analyze/Common.hs +15/−0
• src/Blockchain/Analyze/Decompile.hs +32/−0
• src/Blockchain/Analyze/IR.hs +253/−0
• src/Blockchain/Analyze/Servant.hs +5/−0
• src/Blockchain/Analyze/Servant/API.hs +93/−0
• src/Blockchain/Analyze/Servant/API/Internal.hs +14/−0
• src/Blockchain/Analyze/Servant/Server.hs +120/−0
• src/Blockchain/Analyze/Servant/Server/Handlers.hs +63/−0
• src/Blockchain/Analyze/Servant/Server/Instrument.hs +104/−0
• src/Blockchain/Analyze/Servant/Server/Logging.hs +84/−0
• src/Blockchain/Analyze/Util.hs +71/−0
• src/Blockchain/Jsonrpc/Client.hs +199/−0
• test/Blockchain/Analyze/CfgAugWithTopNPassSpec.hs +24/−0
• test/Blockchain/Analyze/CfgAugmentPassSpec.hs +172/−0
• test/Blockchain/Analyze/IRSpec.hs +177/−0
• test/Blockchain/Analyze/UtilSpec.hs +386/−0
• test/Blockchain/AnalyzeSpec.hs +161/−0
• test/Spec.hs +2/−0
• test/SpecCommon.hs +22/−0

@@ -0,0 +1,5 @@+# Revision history for ethereum-analyzer++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,202 @@++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright 2017 Kevin Chen++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.

@@ -0,0 +1,1 @@+# ethereum-analyzer

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,131 @@+name:                ethereum-analyzer+version:             0.0.1+synopsis:            A Ethereum contract analyzer.+homepage:            https://github.com/ethereumK/ethereum-analyzer+license:             Apache-2.0+license-file:        LICENSE+author:              Kevin Chen+maintainer:          k_@berkeley.edu+category:            Ethereum, Static Analysis+build-type:          Simple+extra-source-files:  ChangeLog.md, README.md+cabal-version:       >=1.10+description:         A Ethereum contract analyzer.++source-repository this+  type:     git+  location: https://github.com/zchn/ethereum-analyzer+  branch:   master+  tag:      v0.0.1++library+  build-depends:       base >= 4 && < 5,+                       aeson,+                       bimap,+                       bytestring,+                       conduit-combinators,+                       conduit-extra,+                       containers,+                       ethereum-analyzer-deps,+                       exceptions,+                       extra,+                       fgl,+                       graphviz,+                       hexstring,+                       hflags,+                       hoopl >= 3.10.2.1,+                       http-conduit,+                       http-media,+                       http-types,+                       json-rpc,+                       logging-effect,+                       monad-logger,+                       mtl,+                       neat-interpolation,+                       network,+                       optparse-applicative,+                       prometheus-client,+                       prometheus-metrics-ghc,+                       protolude,+                       servant,+                       servant-server,+                       text,+                       time,+                       unordered-containers,+                       vector,+                       wai,+                       wai-extra,+                       wai-middleware-prometheus,+                       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+                                  +  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+                     , SpecCommon+  build-depends:       base+                     , bytestring+                     , ethereum-analyzer+                     , ethereum-analyzer-deps+                     , extra+                     , hoopl+                     , hspec+                     , text+  default-language:    Haskell98

@@ -0,0 +1,72 @@+{-# 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)

@@ -0,0 +1,9 @@+-- | Launch ethereum-analyzer server.+module Main+  ( main+  ) where++import Blockchain.Analyze.Servant (startApp)++main :: IO ()+main = startApp

@@ -0,0 +1,11 @@+{-# 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

@@ -0,0 +1,370 @@+{-# 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)

@@ -0,0 +1,140 @@+{-# 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+           }

@@ -0,0 +1,15 @@+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

@@ -0,0 +1,32 @@+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

@@ -0,0 +1,253 @@+{-# 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)

@@ -0,0 +1,5 @@+module Blockchain.Analyze.Servant+  ( startApp+  ) where++import Blockchain.Analyze.Servant.Server (startApp)

@@ -0,0 +1,93 @@+{-# 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>+         |]

@@ -0,0 +1,14 @@+-- | 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")

@@ -0,0 +1,120 @@+{-# 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)

@@ -0,0 +1,63 @@+{-# 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 "" "")

@@ -0,0 +1,104 @@+{-# 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")]

@@ -0,0 +1,84 @@+{-# 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)

@@ -0,0 +1,71 @@+{-# 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

@@ -0,0 +1,199 @@+{-# 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))

@@ -0,0 +1,24 @@+{-# 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]"

@@ -0,0 +1,172 @@+{-# 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" ++ ")]))"

@@ -0,0 +1,177 @@+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" ++ ")]))"

@@ -0,0 +1,386 @@+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" ++ "}"

@@ -0,0 +1,161 @@+{-# 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\"]"

@@ -0,0 +1,2 @@+-- file test/Spec.hs+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}++module SpecCommon+  ( hexcode1+  , hexcode2+  , voteHexcode+  ) where++import Data.ByteString++hexcode1 :: ByteString+hexcode1 =+  "6060604052600261010860005055604051611b51380380611b51833981016040528080518201919060200180519060200190919080519060200190919050505b805b83835b600060018351016001600050819055503373ffffffffffffffffffffffffffffffffffffffff16600260005060016101008110156100025790900160005b5081905550600161010260005060003373ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060005081905550600090505b825181101561016e5782818151811015610002579060200190602002015173ffffffffffffffffffffffffffffffffffffffff166002600050826002016101008110156100025790900160005b508190555080600201610102600050600085848151811015610002579060200190602002015173ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050819055505b80600101905080506100c2565b816000600050819055505b505050806101056000508190555061018f6101ad565b610107600050819055505b505b505050611992806101bf6000396000f35b600062015180420490506101bc565b9056606060405236156100f8576000357c010000000000000000000000000000000000000000000000000000000090048063173825d9146101605780632f54bf6e146101785780634123cb6b146101a457806352375093146101c757806354fd4d50146101ea5780635c52c2f51461020d578063659010e71461021c5780637065cb481461023f578063746c917114610257578063797af6271461027a578063b20d30a9146102a6578063b61d27f6146102be578063b75c7dc614610307578063ba51a6df1461031f578063c2cf732614610337578063cbf0b0c01461036c578063f00d4b5d14610384578063f1736d86146103a5576100f8565b61015e5b600034111561015b577fe1fffcc4923d04b559f4d29a8bfc6cda04eb5b0d3c460751c2402c5c5cc9109c3334604051808373ffffffffffffffffffffffffffffffffffffffff1681526020018281526020019250505060405180910390a15b5b565b005b61017660048080359060200190919050506107c4565b005b61018e60048080359060200190919050506109a5565b6040518082815260200191505060405180910390f35b6101b16004805050610a91565b6040518082815260200191505060405180910390f35b6101d46004805050610b38565b6040518082815260200191505060405180910390f35b6101f76004805050610b42565b6040518082815260200191505060405180910390f35b61021a6004805050610adf565b005b6102296004805050610b2e565b6040518082815260200191505060405180910390f35b610255600480803590602001909190505061066e565b005b6102646004805050610a88565b6040518082815260200191505060405180910390f35b6102906004808035906020019091905050610f0e565b6040518082815260200191505060405180910390f35b6102bc6004808035906020019091905050610a9a565b005b6102f160048080359060200190919080359060200190919080359060200190820180359060200191909192905050610b9e565b6040518082815260200191505060405180910390f35b61031d60048080359060200190919050506103c8565b005b610335600480803590602001909190505061090f565b005b61035660048080359060200190919080359060200190919050506109e7565b6040518082815260200191505060405180910390f35b6103826004808035906020019091905050610b4c565b005b6103a360048080359060200190919080359060200190919050506104ca565b005b6103b26004805050610b24565b6040518082815260200191505060405180910390f35b60006000600061010260005060003373ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050549250600083141561040f576104c4565b8260020a91506101036000506000858152602001908152602001600020600050905060008282600101600050541611156104c3578060000160008181505480929190600101919050555081816001016000828282505403925050819055507fc7fb647e59b18047309aa15aad418e5d7ca96d173ad704f1031a2c3d7591734b3385604051808373ffffffffffffffffffffffffffffffffffffffff1681526020018281526020019250505060405180910390a15b5b50505050565b600060003643604051808484808284378201915050828152602001935050505060405180910390206104fb816112db565b1561066757610509836109a5565b156105145750610669565b61010260005060008573ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060005054915060008214156105565750610669565b61055e611777565b8273ffffffffffffffffffffffffffffffffffffffff166002600050836101008110156100025790900160005b5081905550600061010260005060008673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050819055508161010260005060008573ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050819055507fb532073b38c83145e3e5135377a08bf9aab55bc0fd7c1179cd4fb995d2a5159c8484604051808373ffffffffffffffffffffffffffffffffffffffff1681526020018273ffffffffffffffffffffffffffffffffffffffff1681526020019250505060405180910390a15b505b505050565b600036436040518084848082843782019150508281526020019350505050604051809103902061069d816112db565b156107bf576106ab826109a5565b156106b657506107c1565b6106be611777565b60fa6001600050541015156106d7576106d561153d565b505b60fa6001600050541015156106ec57506107c1565b60016000818150548092919060010191905055508173ffffffffffffffffffffffffffffffffffffffff1660026000506001600050546101008110156100025790900160005b508190555060016000505461010260005060008473ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050819055507f994a936646fe87ffe4f1e469d3d6aa417d6b855598397f323de5b449f765f0c382604051808273ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390a15b505b50565b600060003643604051808484808284378201915050828152602001935050505060405180910390206107f5816112db565b156109095761010260005060008473ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050549150600082141561083c575061090b565b6001600160005054036000600050541115610857575061090b565b60006002600050836101008110156100025790900160005b5081905550600061010260005060008573ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050819055506108b2611777565b6108ba61153d565b507f58619076adf5bb0943d100ef88d52d7c3fd691b19d3a9071b555b651fbf418da83604051808273ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390a15b505b5050565b600036436040518084848082843782019150508281526020019350505050604051809103902061093e816112db565b156109a05760016000505482111561095657506109a2565b81600060005081905550610968611777565b7facbdb084c721332ac59f9b8e392196c9eb0e4932862da8eb9beaf0dad4f550da826040518082815260200191505060405180910390a15b505b50565b6000600061010260005060008473ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050541190506109e2565b919050565b60006000600060006101036000506000878152602001908152602001600020600050925061010260005060008673ffffffffffffffffffffffffffffffffffffffff1681526020019081526020016000206000505491506000821415610a505760009350610a7f565b8160020a90506000818460010160005054161415610a755760009350610a7f56610a7e565b60019350610a7f565b5b50505092915050565b60006000505481565b60016000505481565b6000364360405180848480828437820191505082815260200193505050506040518091039020610ac9816112db565b15610ada5781610105600050819055505b505b50565b6000364360405180848480828437820191505082815260200193505050506040518091039020610b0e816112db565b15610b20576000610106600050819055505b505b565b6101056000505481565b6101066000505481565b6101076000505481565b6101086000505481565b6000364360405180848480828437820191505082815260200193505050506040518091039020610b7b816112db565b15610b99578173ffffffffffffffffffffffffffffffffffffffff16ff5b505b50565b6000610ba9336109a5565b15610f0557610bb7846116d7565b15610ca0577f92ca3a80853e6663fa31fa10b99225f18d4902939b4c53a9caae9043f6efd0043385878686604051808673ffffffffffffffffffffffffffffffffffffffff1681526020018581526020018473ffffffffffffffffffffffffffffffffffffffff1681526020018060200182810382528484828181526020019250808284378201915050965050505050505060405180910390a18473ffffffffffffffffffffffffffffffffffffffff168484846040518083838082843782019150509250505060006040518083038185876185025a03f1925050505060006001029050610f06565b600036436040518084848082843782019150508281526020019350505050604051809103902090508050610cd381610f0e565b158015610d3357506000610109600050600083815260200190815260200160002060005060000160009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16145b15610f045784610109600050600083815260200190815260200160002060005060000160006101000a81548173ffffffffffffffffffffffffffffffffffffffff0219169083021790555083610109600050600083815260200190815260200160002060005060010160005081905550828261010960005060008481526020019081526020016000206000506002016000509190828054600181600116156101000203166002900490600052602060002090601f016020900481019282601f10610e0857803560ff1916838001178555610e39565b82800160010185558215610e39579182015b82811115610e38578235826000505591602001919060010190610e1a565b5b509050610e649190610e46565b80821115610e605760008181506000905550600101610e46565b5090565b50507f1733cbb53659d713b79580f79f3f9ff215f78a7c7aa45890f3b89fc5cddfbf32813386888787604051808781526020018673ffffffffffffffffffffffffffffffffffffffff1681526020018581526020018473ffffffffffffffffffffffffffffffffffffffff168152602001806020018281038252848482818152602001925080828437820191505097505050505050505060405180910390a15b5b5b949350505050565b600081610f1a816112db565b156112d4576000610109600050600085815260200190815260200160002060005060000160009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff161415156112d357610109600050600084815260200190815260200160002060005060000160009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16610109600050600085815260200190815260200160002060005060010160005054610109600050600086815260200190815260200160002060005060020160005060405180828054600181600116156101000203166002900480156110765780601f1061104b57610100808354040283529160200191611076565b820191906000526020600020905b81548152906001019060200180831161105957829003601f168201915b505091505060006040518083038185876185025a03f192505050507fe7c957c06e9a662c1a6c77366179f5b702b97651dc28eee7d5bf1dff6e40bb4a3384610109600050600087815260200190815260200160002060005060010160005054610109600050600088815260200190815260200160002060005060000160009054906101000a900473ffffffffffffffffffffffffffffffffffffffff166101096000506000898152602001908152602001600020600050600201600050604051808673ffffffffffffffffffffffffffffffffffffffff1681526020018581526020018481526020018373ffffffffffffffffffffffffffffffffffffffff168152602001806020018281038252838181546001816001161561010002031660029004815260200191508054600181600116156101000203166002900480156112005780601f106111d557610100808354040283529160200191611200565b820191906000526020600020905b8154815290600101906020018083116111e357829003601f168201915b5050965050505050505060405180910390a1610109600050600084815260200190815260200160002060006000820160006101000a81549073ffffffffffffffffffffffffffffffffffffffff0219169055600182016000506000905560028201600050805460018160011615610100020316600290046000825580601f1061128957506112c6565b601f0160209004906000526020600020908101906112c591906112a7565b808211156112c157600081815060009055506001016112a7565b5090565b5b50505060019150506112d6565b5b505b919050565b600060006000600061010260005060003373ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600050549250600083141561132457611535565b610103600050600086815260200190815260200160002060005091506000826000016000505414156113fd57600060005054826000016000508190555060008260010160005081905550610104600050805480919060010190908154818355818115116113c3578183600052602060002091820191016113c291906113a4565b808211156113be57600081815060009055506001016113a4565b5090565b5b5050508260020160005081905550846101046000508360020160005054815481101561000257906000526020600020900160005b50819055505b8260020a90506000818360010160005054161415611534577fe1c52dc63b719ade82e8bea94cc41a0d5d28e4aaf536adb5e9cccc9ff8c1aeda3386604051808373ffffffffffffffffffffffffffffffffffffffff1681526020018281526020019250505060405180910390a16001826000016000505411151561150757610104600050610103600050600087815260200190815260200160002060005060020160005054815481101561000257906000526020600020900160005b50600090556101036000506000868152602001908152602001600020600060008201600050600090556001820160005060009055600282016000506000905550506001935061153556611533565b816000016000818150548092919060019003919050555080826001016000828282505417925050819055505b5b5b505050919050565b60006000600190505b6001600050548110156116d2575b60016000505481108015611580575060006002600050826101008110156100025790900160005b505414155b15611592578080600101915050611554565b5b60016001600050541180156115c45750600060026000506001600050546101008110156100025790900160005b5054145b156115e357600160008181505480929190600190039190505550611593565b600160005054811080156116145750600060026000506001600050546101008110156100025790900160005b505414155b8015611637575060006002600050826101008110156100025790900160005b5054145b156116cd5760026000506001600050546101008110156100025790900160005b50546002600050826101008110156100025790900160005b50819055508061010260005060006002600050846101008110156100025790900160005b5054815260200190815260200160002060005081905550600060026000506001600050546101008110156100025790900160005b50819055505b611546565b5b5090565b60006116e2336109a5565b1561177157610107600050546116f6611980565b111561171b57600061010660005081905550611710611980565b610107600050819055505b610106600050548261010660005054011015801561174757506101056000505482610106600050540111155b15611768578161010660008282825054019250508190555060019050611772565b60009050611772565b5b919050565b60006000610104600050805490509150600090505b8181101561187857610109600050600061010460005083815481101561000257906000526020600020900160005b5054815260200190815260200160002060006000820160006101000a81549073ffffffffffffffffffffffffffffffffffffffff0219169055600182016000506000905560028201600050805460018160011615610100020316600290046000825580601f1061182a5750611867565b601f0160209004906000526020600020908101906118669190611848565b808211156118625760008181506000905550600101611848565b5090565b5b5050505b806001019050805061178c565b611880611885565b5b5050565b60006000610104600050805490509150600090505b8181101561193857600060010261010460005082815481101561000257906000526020600020900160005b505414151561192a57610103600050600061010460005083815481101561000257906000526020600020900160005b50548152602001908152602001600020600060008201600050600090556001820160005060009055600282016000506000905550505b5b806001019050805061189a565b61010460005080546000825590600052602060002090810190611979919061195b565b80821115611975576000818150600090555060010161195b565b5090565b5b505b5050565b6000620151804204905061198f565b9056"++hexcode2 :: ByteString+hexcode2 =+  "6060604052361560275760e060020a600035046341c0e1b58114606e578063e5225381146096575b60d56000341115606c57346060908152605890600160a060020a033316907f90890809c654f11d6e72a28fa60149770a0d11ec6c92319d6ceb2bb0a4ea1a1590602090a35b565b60d5600054600160a060020a0390811633919091161415606c57600054600160a060020a0316ff5b60d5600054600160a060020a0390811633919091161415606c5760008054600160a060020a039081169190301631606082818181858883f15050505050565b00"++-- http://solidity.readthedocs.io/en/develop/solidity-by-example.html+voteHexcode :: ByteString+voteHexcode =+  "6060604052341561000c57fe5b604051610abd380380610abd833981016040528080518201919050505b600033600060006101000a81548173ffffffffffffffffffffffffffffffffffffffff021916908373ffffffffffffffffffffffffffffffffffffffff160217905550600160016000600060009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060000181905550600090505b815181101561016b57600280548060010182816100f89190610173565b916000526020600020906002020160005b604060405190810160405280868681518110151561012357fe5b906020019060200201516000191681526020016000815250909190915060008201518160000190600019169055602082015181600101555050505b80806001019150506100db565b5b50506101d5565b8154818355818115116101a05760020281600202836000526020600020918201910161019f91906101a5565b5b505050565b6101d291905b808211156101ce57600060008201600090556001820160009055506002016101ab565b5090565b90565b6108d9806101e46000396000f3006060604052361561008c576000357c0100000000000000000000000000000000000000000000000000000000900463ffffffff1680630121b93f1461008e578063013cf08b146100ae5780632e4176cf146100f15780635c19a95c14610143578063609ff1bd146101795780639e7b8d611461019f578063a3ec138d146101d5578063e2ba53f014610264575bfe5b341561009657fe5b6100ac6004808035906020019091905050610292565b005b34156100b657fe5b6100cc6004808035906020019091905050610352565b6040518083600019166000191681526020018281526020019250505060405180910390f35b34156100f957fe5b610101610386565b604051808273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200191505060405180910390f35b341561014b57fe5b610177600480803573ffffffffffffffffffffffffffffffffffffffff169060200190919050506103ac565b005b341561018157fe5b610189610696565b6040518082815260200191505060405180910390f35b34156101a757fe5b6101d3600480803573ffffffffffffffffffffffffffffffffffffffff1690602001909190505061071d565b005b34156101dd57fe5b610209600480803573ffffffffffffffffffffffffffffffffffffffff1690602001909190505061081c565b60405180858152602001841515151581526020018373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200182815260200194505050505060405180910390f35b341561026c57fe5b610274610879565b60405180826000191660001916815260200191505060405180910390f35b6000600160003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002090508060010160009054906101000a900460ff16156102f157610000565b60018160010160006101000a81548160ff021916908315150217905550818160020181905550806000015460028381548110151561032b57fe5b906000526020600020906002020160005b50600101600082825401925050819055505b5050565b60028181548110151561036157fe5b906000526020600020906002020160005b915090508060000154908060010154905082565b600060009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1681565b60006000600160003373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002091508160010160009054906101000a900460ff161561040d57610000565b3373ffffffffffffffffffffffffffffffffffffffff168373ffffffffffffffffffffffffffffffffffffffff16141561044657610000565b5b600073ffffffffffffffffffffffffffffffffffffffff16600160008573ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060010160019054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1614151561058257600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060010160019054906101000a900473ffffffffffffffffffffffffffffffffffffffff1692503373ffffffffffffffffffffffffffffffffffffffff168373ffffffffffffffffffffffffffffffffffffffff16141561057d57610000565b610447565b60018260010160006101000a81548160ff021916908315150217905550828260010160016101000a81548173ffffffffffffffffffffffffffffffffffffffff021916908373ffffffffffffffffffffffffffffffffffffffff160217905550600160008473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002090508060010160009054906101000a900460ff16156106795781600001546002826002015481548110151561065257fe5b906000526020600020906002020160005b5060010160008282540192505081905550610690565b816000015481600001600082825401925050819055505b5b505050565b60006000600060009150600090505b60028054905081101561071757816002828154811015156106c257fe5b906000526020600020906002020160005b50600101541115610709576002818154811015156106ed57fe5b906000526020600020906002020160005b506001015491508092505b5b80806001019150506106a5565b5b505090565b600060009054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff163373ffffffffffffffffffffffffffffffffffffffff161415806107c65750600160008273ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff16815260200190815260200160002060010160009054906101000a900460ff165b156107d057610000565b6001600160008373ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff168152602001908152602001600020600001819055505b50565b60016020528060005260406000206000915090508060000154908060010160009054906101000a900460ff16908060010160019054906101000a900473ffffffffffffffffffffffffffffffffffffffff16908060020154905084565b60006002610885610696565b81548110151561089157fe5b906000526020600020906002020160005b506000015490505b905600a165627a7a7230582083216429ab08775d8e6d7b7643b8ab38785e52186a5dca7d37aefaf2103eabcb0029"