├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── Setup.hs ├── executables └── Masala.hs ├── masala.cabal ├── src └── Masala │ ├── Ext │ └── Simple.hs │ ├── Instruction.hs │ ├── RPC.hs │ ├── Repl.hs │ ├── VM.hs │ ├── VM │ ├── Dispatch.hs │ ├── Gas.hs │ ├── Memory.hs │ └── Types.hs │ └── Word.hs ├── stack.yaml ├── testfiles ├── vmArithmeticTest.json ├── vmBitwiseLogicOperationTest.json ├── vmEnvironmentalInfoTest.json ├── vmIOandFlowOperationsTest.json ├── vmPushDupSwapTest.json ├── vmSha3Test.json └── vmtests.json └── tests ├── JSONSpec.hs ├── MemorySpec.hs └── Tests.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | .cabal-sandbox 3 | cabal.sandbox.config 4 | var 5 | TAGS 6 | /testfiles/VMTests 7 | .stack-work 8 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This is the complex Travis configuration, which is intended for use 2 | # on open source libraries which need compatibility across multiple GHC 3 | # versions, must work with cabal-install, and should be 4 | # cross-platform. For more information and other options, see: 5 | # 6 | # https://docs.haskellstack.org/en/stable/travis_ci/ 7 | # 8 | # Copy these contents into the root directory of your Github project in a file 9 | # named .travis.yml 10 | 11 | # Use new container infrastructure to enable caching 12 | sudo: false 13 | 14 | # Choose a lightweight base image; we provide our own build tools. 15 | language: c 16 | 17 | # Caching so the next build will be fast too. 18 | cache: 19 | directories: 20 | - $HOME/.ghc 21 | - $HOME/.cabal 22 | - $HOME/.stack 23 | 24 | # The different configurations we want to test. We have BUILD=cabal which uses 25 | # cabal-install, and BUILD=stack which uses Stack. More documentation on each 26 | # of those below. 27 | # 28 | # We set the compiler values here to tell Travis to use a different 29 | # cache file per set of arguments. 30 | # 31 | # If you need to have different apt packages for each combination in the 32 | # matrix, you can use a line such as: 33 | # addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}} 34 | matrix: 35 | include: 36 | # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See: 37 | # https://github.com/hvr/multi-ghc-travis 38 | #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 39 | # compiler: ": #GHC 7.0.4" 40 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 41 | #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 42 | # compiler: ": #GHC 7.2.2" 43 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 44 | # - env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 45 | # compiler: ": #GHC 7.4.2" 46 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 47 | # - env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 48 | # compiler: ": #GHC 7.6.3" 49 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 50 | # - env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7 51 | # compiler: ": #GHC 7.8.4" 52 | # addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 53 | # - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7 54 | # compiler: ": #GHC 7.10.3" 55 | # addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 56 | # - env: BUILD=cabal GHCVER=8.0.1 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 57 | # compiler: ": #GHC 8.0.1" 58 | # addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 59 | 60 | # Build with the newest GHC and cabal-install. This is an accepted failure, 61 | # see below. 62 | # - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 63 | # compiler: ": #GHC HEAD" 64 | # addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 65 | 66 | # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS 67 | # variable, such as using --stack-yaml to point to a different file. 68 | 69 | # removing this build to focus on mac for now 70 | 71 | #- env: BUILD=stack ARGS="" 72 | # compiler: ": #stack default" 73 | # addons: {apt: {packages: [libgmp-dev]}} 74 | 75 | # - env: BUILD=stack ARGS="--resolver lts-2" 76 | # compiler: ": #stack 7.8.4" 77 | # addons: {apt: {packages: [libgmp-dev]}} 78 | # 79 | # - env: BUILD=stack ARGS="--resolver lts-3" 80 | # compiler: ": #stack 7.10.2" 81 | # addons: {apt: {packages: [libgmp-dev]}} 82 | # 83 | # - env: BUILD=stack ARGS="--resolver lts-6" 84 | # compiler: ": #stack 7.10.3" 85 | # addons: {apt: {packages: [libgmp-dev]}} 86 | # 87 | # - env: BUILD=stack ARGS="--resolver lts-7" 88 | # compiler: ": #stack 8.0.1" 89 | # addons: {apt: {packages: [libgmp-dev]}} 90 | # 91 | # # Nightly builds are allowed to fail 92 | # - env: BUILD=stack ARGS="--resolver nightly" 93 | # compiler: ": #stack nightly" 94 | # addons: {apt: {packages: [libgmp-dev]}} 95 | 96 | # OSX Build El Cap 97 | - env: BUILD=stack ARGS="" 98 | compiler: ": #stack default osx default (el cap)" 99 | os: osx 100 | addons: 101 | artifacts: 102 | paths: 103 | - .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/masala/masala 104 | 105 | # OSX Build Yosemite 106 | - env: BUILD=stack ARGS="" 107 | compiler: ": #stack default osx (yosemite)" 108 | os: osx 109 | osx_image: xcode7.1 110 | addons: 111 | artifacts: 112 | paths: 113 | - .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/masala/masala 114 | 115 | # Travis includes an OS X which is incompatible with GHC 7.8.4 116 | #- env: BUILD=stack ARGS="--resolver lts-2" 117 | # compiler: ": #stack 7.8.4 osx" 118 | # os: osx 119 | 120 | # - env: BUILD=stack ARGS="--resolver lts-3" 121 | # compiler: ": #stack 7.10.2 osx" 122 | # os: osx 123 | # 124 | # - env: BUILD=stack ARGS="--resolver lts-6" 125 | # compiler: ": #stack 7.10.3 osx" 126 | # os: osx 127 | # 128 | # - env: BUILD=stack ARGS="--resolver lts-7" 129 | # compiler: ": #stack 8.0.1 osx" 130 | # os: osx 131 | # 132 | # - env: BUILD=stack ARGS="--resolver nightly" 133 | # compiler: ": #stack nightly osx" 134 | # os: osx 135 | 136 | allow_failures: [] 137 | # - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 138 | # - env: BUILD=stack ARGS="--resolver nightly" 139 | 140 | before_install: 141 | # Using compiler above sets CC to an invalid value, so unset it 142 | - unset CC 143 | 144 | # We want to always allow newer versions of packages when building on GHC HEAD 145 | - CABALARGS="" 146 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 147 | 148 | # Download and unpack the stack executable 149 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH 150 | - mkdir -p ~/.local/bin 151 | - | 152 | if [ `uname` = "Darwin" ] 153 | then 154 | travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 155 | else 156 | travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 157 | fi 158 | 159 | # Use the more reliable S3 mirror of Hackage 160 | mkdir -p $HOME/.cabal 161 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 162 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 163 | 164 | if [ "$CABALVER" != "1.16" ] 165 | then 166 | echo 'jobs: $ncpus' >> $HOME/.cabal/config 167 | fi 168 | 169 | install: 170 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 171 | - if [ -f configure.ac ]; then autoreconf -i; fi 172 | - | 173 | set -ex 174 | case "$BUILD" in 175 | stack) 176 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 177 | ;; 178 | cabal) 179 | cabal --version 180 | travis_retry cabal update 181 | 182 | # Get the list of packages from the stack.yaml file 183 | PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 184 | 185 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 186 | ;; 187 | esac 188 | set +ex 189 | 190 | script: 191 | - | 192 | set -ex 193 | case "$BUILD" in 194 | stack) 195 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps 196 | ;; 197 | cabal) 198 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 199 | 200 | ORIGDIR=$(pwd) 201 | for dir in $PACKAGES 202 | do 203 | cd $dir 204 | cabal check || [ "$CABALVER" == "1.16" ] 205 | cabal sdist 206 | PKGVER=$(cabal info . | awk '{print $2;exit}') 207 | SRC_TGZ=$PKGVER.tar.gz 208 | cd dist 209 | tar zxfv "$SRC_TGZ" 210 | cd "$PKGVER" 211 | cabal configure --enable-tests 212 | cabal build 213 | cd $ORIGDIR 214 | done 215 | ;; 216 | esac 217 | set +ex 218 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Stuart Popejoy 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 16 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 17 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 18 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 19 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 21 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Masala: Pure Ethereum VM and RPC with flexible backends, gas model 2 | ================================================================== 3 | 4 | Implementation of Ethereum VM, to support investigations into hosting EVM and bytecode 5 | in a pure consensus-backed ledger such as Juno. 6 | 7 | VM/Bytecode interpreter 8 | ----------------------- 9 | 10 | `Masala.VM` houses the main interpreter, which sports a tight dispatch driven by the 11 | yellow paper spec ensuring that the stack interop is correct. 12 | 13 | Showcases Haskell's superior numeric flexibility by leveraging 14 | `Word256`, `Int256`, `Word8` and `Word160` to represent the main EVM 15 | datatypes, with the respective newtypes `U256`, `S256`, `U8` and 16 | `Address` supporting automatic JSON conversion. 17 | 18 | Gas Models 19 | ---------- 20 | 21 | Supports ethereum's complex gas model, as well as a `FixedGasModel` of one-unit-per-instruction. 22 | 23 | Backend Polymorphism 24 | -------------------- 25 | 26 | VM Backend is represented as the `MonadExt` typeclass, with a basic implementation. This can 27 | easily be extended to write to a database, etc. 28 | 29 | Because it's a transformer typeclass, it easily hoists into the RPC monad or runs standalone. 30 | Note however the transformer implementations only allow it to be the "inner" monad on the stack. 31 | 32 | REPL/RPC 33 | -------- 34 | 35 | To run repl in GHCI, load module 'Masala.Repl', issue `_repl`, and enter RPC JSON calls. 36 | 37 | ``` 38 | Solidity code: 39 | contract SimpleStorage2 { 40 | uint storedData; 41 | function set(uint x) { 42 | storedData = x; 43 | } 44 | function get() constant returns (uint retVal) { 45 | return storedData; 46 | } 47 | } 48 | ``` 49 | 50 | ``` 51 | ghci> :load Masala.Repl 52 | Ok, modules loaded: Masala.VM, Masala.Instruction, Masala.Word, Masala.Ext.Simple, Masala.VM.Types, Masala.VM.Dispatch, Masala.VM.Memory, Masala.VM.Gas, Masala.RPC, Masala.Repl. 53 | ghci> _repl 54 | > {"method":"eth_sendTransaction","params":[{"from":"1e240","data":"0x606060405260908060106000396000f360606040526000357c01000000000000000000000000000000000000000000000000000000009004806360fe47b11460415780636d4ce63c14605257603f565b005b60506004803590602001506071565b005b605b600450607f565b6040518082815260200191505060405180910390f35b806000600050819055505b50565b60006000600050549050608d565b9056"}]} 55 | sendTransaction: SendTran {stfrom = 1e240, stto = Nothing, stgas = Nothing, stgasPrice = Nothing, stvalue = Nothing, stdata = Just 0x606060405260908060106000396000f360606040526000357c01000000000000000000000000000000000000000000000000000000009004806360fe47b11460415780636d4ce63c14605257603f565b005b60506004803590602001506071565b005b605b600450607f565b6040518082815260200191505060405180910390f35b806000600050819055505b50565b60006000600050549050608d565b9056, stnonce = Nothing} 56 | [...] 57 | sendTransaction: Success, addr=1e241, output=[60,60,60,40,52,60,0,35,7c,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,90,4,80,63,60,fe,47,b1,14,60,41,57,80,63,6d,4c,e6,3c,14,60,52,57,60,3f,56,5b,0,5b,60,50,60,4,80,35,90,60,20,1,50,60,71,56,5b,0,5b,60,5b,60,4,50,60,7f,56,5b,60,40,51,80,82,81,52,60,20,1,91,50,50,60,40,51,80,91,3,90,f3,5b,80,60,0,60,0,50,81,90,55,50,5b,50,56,5b,60,0,60,0,60,0,50,54,90,50,60,8d,56,5b,90,56] 58 | "Success, addr=1e241, acct=Just ExtAccount {code=*bytecode*, bal=0, addy=1e241, store=fromList []" 59 | > {"method":"eth_call","params":[{"to":"1e241","data":"0x60fe47b1000000000000000000000000000000000000000000000000000000000000cafe"},"0x0"]} 60 | [...] 61 | call: Success, output= 62 | > {"method":"eth_call","params":[{"to":"1e241","data":"0x6d4ce63c00000000000000000000000000000000000000000000000000000000"},"0x0"]} 63 | [...] 64 | call: Success, output=000000000000000000000000000000000000000000000000000000000000cafe 65 | ``` 66 | 67 | The repl implements an IORef state model suitable for plugging into a consensus state machine like Juno. 68 | 69 | JSON Test Suite 70 | --------------- 71 | 72 | A subset of the go and cpp tests (circa December 2015) are included, which are executed as an HSpec test. 73 | 74 | Note that I extended the JSON format to include a "skip" key, for the 75 | tests which are intentionally unsupported. This includes some quirks 76 | of the go code test fixture, i.e. creating accounts on overflow, etc. 77 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /executables/Masala.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Masala.Repl 4 | 5 | main :: IO () 6 | main = repl 7 | -------------------------------------------------------------------------------- /masala.cabal: -------------------------------------------------------------------------------- 1 | -- Initial masala.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: masala 5 | version: 0.2.0.0 6 | -- synopsis: 7 | -- description: 8 | -- license: 9 | -- license-file: LICENSE 10 | author: Stuart Popejoy 11 | maintainer: spopejoy@panix.com 12 | -- copyright: 13 | -- category: 14 | build-type: Simple 15 | -- extra-source-files: 16 | cabal-version: >=1.10 17 | 18 | library 19 | exposed-modules: 20 | Masala.VM 21 | Masala.VM.Types 22 | Masala.VM.Dispatch 23 | Masala.VM.Memory 24 | Masala.VM.Gas 25 | Masala.Ext.Simple 26 | Masala.Instruction 27 | Masala.RPC 28 | Masala.Repl 29 | Masala.Word 30 | -- other-modules: 31 | -- other-extensions: 32 | ghc-options: -Wall 33 | build-depends: 34 | base >=4.7 && <4.9 35 | , aeson 36 | , bytestring 37 | , containers >= 0.5 38 | , cryptonite 39 | , data-dword 40 | , directory 41 | , hspec 42 | , lens 43 | , lens-aeson 44 | , memory 45 | , mtl 46 | , servant 47 | , snap-core 48 | , snap-server 49 | , snap-core-cors 50 | , split 51 | , text 52 | , transformers 53 | , unordered-containers 54 | , vector 55 | hs-source-dirs: src 56 | default-language: Haskell2010 57 | 58 | executable masala 59 | main-is: Masala.hs 60 | build-depends: base < 5 61 | , masala 62 | hs-source-dirs: executables 63 | default-language: Haskell2010 64 | 65 | test-suite tests 66 | type: exitcode-stdio-1.0 67 | main-is: Tests.hs 68 | -- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N 69 | hs-source-dirs: tests 70 | default-language: Haskell2010 71 | build-depends: 72 | aeson 73 | , base 74 | , bytestring 75 | , containers 76 | , directory 77 | , hspec 78 | , lens 79 | , masala 80 | , text 81 | , vector 82 | -------------------------------------------------------------------------------- /src/Masala/Ext/Simple.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | -- | Backend implementation which mutates an 'ExtData', 4 | -- Runs in IO for debug logging. 5 | module Masala.Ext.Simple where 6 | 7 | import qualified Data.Map.Strict as M 8 | import qualified Data.Set as S 9 | import Masala.VM.Types 10 | import Masala.Word 11 | import Control.Lens 12 | import Control.Monad.IO.Class 13 | import Control.Monad 14 | 15 | -- | Backend data structure. 16 | data ExtData = ExtData { 17 | _edAccts :: M.Map Address ExtAccount 18 | , _edSuicides :: S.Set Address 19 | , _edCreates :: S.Set Address 20 | , _edRefund :: M.Map Address Gas 21 | , _edLog :: [LogEntry] 22 | , _edDebug :: Bool 23 | } deriving (Eq,Show) 24 | 25 | $(makeLenses ''ExtData) 26 | 27 | emptyExtData :: ExtData 28 | emptyExtData = ExtData mempty mempty mempty mempty mempty True 29 | 30 | -- | MExt is State-like + IO 31 | newtype MExt a = MExt { runMExt :: ExtData -> IO (a,ExtData) } 32 | 33 | instance Functor MExt where 34 | fmap f (MExt a) = MExt $ \s -> do 35 | (a',s') <- a s 36 | return (f a',s') 37 | instance Applicative MExt where 38 | pure a = MExt $ \s -> return (a,s) 39 | (MExt f) <*> (MExt a) = MExt $ \s -> do 40 | (f',s') <- f s 41 | (a',s'') <- a s' 42 | return (f' a',s'') 43 | instance Monad MExt where 44 | return = pure 45 | (MExt a) >>= f = MExt $ \s -> do 46 | (a',s') <- a s 47 | let (MExt b) = f a' 48 | b s' 49 | 50 | -- | State-like get. 51 | extGet :: MExt ExtData 52 | extGet = MExt $ \e -> return (e,e) 53 | 54 | -- | State-like set. 55 | extSet :: ExtData -> MExt () 56 | extSet d = MExt $ \_ -> return ((),d) 57 | 58 | -- | State-like modify. 59 | extModify :: (ExtData -> ExtData) -> MExt () 60 | extModify f = MExt $ \s -> return ((),f s) 61 | 62 | -- | Lensy state modify. 63 | extOver :: ASetter ExtData ExtData a b -> (a -> b) -> MExt () 64 | extOver l f = extModify $ over l f 65 | 66 | -- | Lensy use. 67 | extUse :: (ExtData -> a) -> MExt a 68 | extUse f = fmap f extGet 69 | 70 | -- | Traversal on state. 71 | extFirstOf :: Getting (Leftmost a) ExtData a -> MExt (Maybe a) 72 | extFirstOf l = extUse $ firstOf l 73 | 74 | -- | Lensy read. 75 | extView :: Getting b ExtData b -> MExt b 76 | extView l = view l <$> extGet 77 | 78 | -- | State-like exec. 79 | extExec :: MExt a -> ExtData -> IO ExtData 80 | extExec o = fmap snd . runMExt o 81 | 82 | -- | State-like eval. 83 | extEval :: MExt a -> ExtData -> IO a 84 | extEval o = fmap fst . runMExt o 85 | 86 | 87 | instance MonadExt MExt where 88 | 89 | {-# INLINE extStore #-} 90 | {-# INLINE extLoad #-} 91 | {-# INLINE extOut #-} 92 | {-# INLINE extDebug #-} 93 | {-# INLINE extAddress #-} 94 | {-# INLINE extCreate #-} 95 | {-# INLINE extSaveCode #-} 96 | {-# INLINE extSuicide #-} 97 | {-# INLINE extRefund #-} 98 | {-# INLINE extIsCreate #-} 99 | {-# INLINE extLog #-} 100 | extStore a k v = extOver (edAccts . ix a . acctStore) 101 | (\m -> if v == 0 then M.delete k m else M.insert k v m) 102 | extLoad a k = extFirstOf (edAccts . ix a . acctStore . ix k) 103 | extAddress k = extFirstOf (edAccts . ix k) 104 | extCreate g = do 105 | newaddy <- succ . maximum . M.keys <$> extView edAccts 106 | let newacct = ExtAccount [] g newaddy M.empty 107 | extOver edCreates (S.insert newaddy) 108 | extOver edAccts (M.insert newaddy newacct) 109 | return newacct 110 | extSaveCode a ws = extModify $ set (edAccts . ix a . acctCode) ws 111 | extSuicide a = do 112 | justDeleted <- S.member a <$> extView edSuicides 113 | extOver edSuicides (S.insert a) 114 | return justDeleted 115 | extRefund a g = extOver edRefund (M.insertWith (+) a g) 116 | extIsCreate a = S.member a <$> extView edCreates 117 | extLog l = extOver edLog (l:) 118 | extOut = liftIO . putStrLn 119 | extDebug s = do 120 | d <- extView edDebug 121 | when d (liftIO $ putStrLn s) 122 | 123 | instance MonadIO MExt where 124 | liftIO a = MExt $ \s -> do 125 | a' <- a 126 | return (a',s) 127 | -------------------------------------------------------------------------------- /src/Masala/Instruction.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE TupleSections #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE DefaultSignatures #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | {-# LANGUAGE PatternSynonyms #-} 7 | 8 | -- | Masala instruction/opcode declaration, specification and parsing. 9 | module Masala.Instruction 10 | ( -- * Data types 11 | ByteCode (..) 12 | ,ToByteCode (..), (+>), wPUSH 13 | ,ParamSpec (..) 14 | ,Spec (..) 15 | ,Instruction (..) 16 | ,parse, parseHex 17 | ,bcToHex 18 | ,bcToU8s,bcsToU8s 19 | ,spec 20 | ) where 21 | 22 | import Prelude hiding (LT,GT,EQ) 23 | import qualified Data.Map as M 24 | import Masala.Word 25 | 26 | 27 | -- | ByteCode representation for VM, optimized for PUSHx operations. 28 | data ByteCode = ByteCode { 29 | -- | Index/address, from source byte sequence. 30 | bcIdx :: Int 31 | -- | Instruction/opcode 32 | , bcInst :: Instruction 33 | -- | Push values, if any 34 | , bcValue :: [U8] 35 | } deriving (Eq) 36 | instance Show ByteCode where 37 | show (ByteCode n i w) = showHex n ++ ":" ++ show i ++ if null w then "" else show w 38 | 39 | -- | Convenience class for repl, mainly. 40 | class ToByteCode a where 41 | toByteCode :: a -> [ByteCode] 42 | -- | In GHCI, issue "default (U256)" to enter bare numbers for push. 43 | default toByteCode :: (Bits a ,Integral a) => a -> [ByteCode] 44 | toByteCode a = return $ wPUSH $ fromIntegral a 45 | 46 | instance ToByteCode U256 47 | instance ToByteCode Instruction where toByteCode i = return $ ByteCode 0 i [] 48 | instance ToByteCode ByteCode where toByteCode = return 49 | instance ToByteCode [ByteCode] where toByteCode = id 50 | 51 | -- | Parameterize PUSHxx, SWAPxx etc 52 | data ParamSpec = 53 | -- | PUSH1 => PushW 1, etc 54 | PushW Int | 55 | -- | DUP2 => Dup 2 ... 56 | Dup Int | 57 | -- | SWAPxxx 58 | Swap Int | 59 | -- | LOGxxx 60 | Log Int 61 | deriving (Eq,Show) 62 | 63 | -- | Instruction/opcode specification, per yellow paper 64 | data Spec = Spec { 65 | -- | Opcode 66 | value :: U8, 67 | -- | How many words to pop off stack 68 | stackIn :: Int, 69 | -- | How many words will be pushed onto stack 70 | stackOut :: Int, 71 | -- | parameterization, if any 72 | paramSpec :: Maybe ParamSpec 73 | } deriving Show 74 | 75 | 76 | -- All instructions. 77 | data Instruction = 78 | STOP 79 | | ADD 80 | | MUL 81 | | SUB 82 | | DIV 83 | | SDIV 84 | | MOD 85 | | SMOD 86 | | ADDMOD 87 | | MULMOD 88 | | EXP 89 | | SIGNEXTEND 90 | | LT 91 | | GT 92 | | SLT 93 | | SGT 94 | | EQ 95 | | ISZERO 96 | | AND 97 | | OR 98 | | XOR 99 | | NOT 100 | | BYTE 101 | | SHA3 102 | | ADDRESS 103 | | BALANCE 104 | | ORIGIN 105 | | CALLER 106 | | CALLVALUE 107 | | CALLDATALOAD 108 | | CALLDATASIZE 109 | | CALLDATACOPY 110 | | CODESIZE 111 | | CODECOPY 112 | | GASPRICE 113 | | EXTCODESIZE 114 | | EXTCODECOPY 115 | | BLOCKHASH 116 | | COINBASE 117 | | TIMESTAMP 118 | | NUMBER 119 | | DIFFICULTY 120 | | GASLIMIT 121 | | POP 122 | | MLOAD 123 | | MSTORE 124 | | MSTORE8 125 | | SLOAD 126 | | SSTORE 127 | | JUMP 128 | | JUMPI 129 | | PC 130 | | MSIZE 131 | | GAS 132 | | JUMPDEST 133 | | PUSH1 134 | | PUSH2 135 | | PUSH3 136 | | PUSH4 137 | | PUSH5 138 | | PUSH6 139 | | PUSH7 140 | | PUSH8 141 | | PUSH9 142 | | PUSH10 143 | | PUSH11 144 | | PUSH12 145 | | PUSH13 146 | | PUSH14 147 | | PUSH15 148 | | PUSH16 149 | | PUSH17 150 | | PUSH18 151 | | PUSH19 152 | | PUSH20 153 | | PUSH21 154 | | PUSH22 155 | | PUSH23 156 | | PUSH24 157 | | PUSH25 158 | | PUSH26 159 | | PUSH27 160 | | PUSH28 161 | | PUSH29 162 | | PUSH30 163 | | PUSH31 164 | | PUSH32 165 | | DUP1 166 | | DUP2 167 | | DUP3 168 | | DUP4 169 | | DUP5 170 | | DUP6 171 | | DUP7 172 | | DUP8 173 | | DUP9 174 | | DUP10 175 | | DUP11 176 | | DUP12 177 | | DUP13 178 | | DUP14 179 | | DUP15 180 | | DUP16 181 | | SWAP1 182 | | SWAP2 183 | | SWAP3 184 | | SWAP4 185 | | SWAP5 186 | | SWAP6 187 | | SWAP7 188 | | SWAP8 189 | | SWAP9 190 | | SWAP10 191 | | SWAP11 192 | | SWAP12 193 | | SWAP13 194 | | SWAP14 195 | | SWAP15 196 | | SWAP16 197 | | LOG0 198 | | LOG1 199 | | LOG2 200 | | LOG3 201 | | LOG4 202 | | CREATE 203 | | CALL 204 | | CALLCODE 205 | | RETURN 206 | | SUICIDE 207 | deriving (Eq,Show,Enum,Ord,Bounded) 208 | 209 | -- | map U8s to Instructions. 210 | valueToInst :: M.Map U8 Instruction 211 | valueToInst = M.fromList $ map assn [minBound .. maxBound] 212 | where assn i = (value (spec i),i) 213 | 214 | -- | parse U8s to bytecode rep. 215 | parse :: [U8] -> Either String [ByteCode] 216 | parse prog = toBC [] . zip [0..] $ prog 217 | where toBC bcs [] = Right $ reverse bcs 218 | toBC bcs ((idx,v):ws) = 219 | case M.lookup v valueToInst of 220 | Nothing -> err idx $ "Instruction expected, parsed: " ++ show (reverse bcs) 221 | Just i -> 222 | case paramSpec (spec i) of 223 | (Just (PushW n)) -> push i idx n bcs ws 224 | _ -> toBC (ByteCode idx i []:bcs) ws 225 | push inst idx n bcs ws 226 | | n > length ws = 227 | err idx ("PUSH" ++show n ++ ": not enough input") 228 | | otherwise = 229 | toBC (ByteCode idx inst (map snd $ take n ws):bcs) (drop n ws) 230 | err idx msg = Left $ msg ++ " (index " ++ show idx ++ 231 | ", value " ++ show (prog !! idx) ++ ")" 232 | 233 | -- | parse hex to bytecode rep. 234 | parseHex :: String -> Either String [ByteCode] 235 | parseHex = either Left parse . readHexs 236 | 237 | -- | back to hex string 238 | bcToHex :: [ByteCode] -> String 239 | bcToHex = showHexs . concatMap bcToU8s 240 | 241 | infixl 8 +> 242 | 243 | -- | convenience for GHCI. With "(default U256)", can write "0x1010 +> 0x11 +> ADD" in ghci, etc. 244 | (+>) :: (ToByteCode a,ToByteCode b) => a -> b -> [ByteCode] 245 | a +> b = ba ++ setIdxs(toByteCode b) 246 | where ba = toByteCode a 247 | prevIdx = if null ba then 0 else idx . head $ reverse ba 248 | idx (ByteCode n _ w) = n + length w 249 | setIdxs = zipWith setIdx [succ prevIdx..] 250 | setIdx i bc = bc { bcIdx = i } 251 | 252 | -- | convenience for entering push values. Can also use "(default U256)". 253 | wPUSH :: U256 -> ByteCode 254 | wPUSH v = ByteCode 0 selectPush ws 255 | where ws = u256ToU8s v 256 | selectPush = [pred PUSH1 ..] !! length ws 257 | 258 | 259 | -- | Bytecode is optimized for PUSH, meaning it's not one-to-one with opcode sequences. 260 | bcToU8s :: ByteCode -> [U8] 261 | bcToU8s (ByteCode _ i []) = return $ value $ spec i 262 | bcToU8s (ByteCode _ i ws) = value (spec i):ws 263 | 264 | -- | Convert back to words. 265 | bcsToU8s :: [ByteCode] -> [U8] 266 | bcsToU8s = concatMap bcToU8s 267 | 268 | -- | Opcode specification, generated from yellow paper. 269 | spec :: Instruction -> Spec 270 | spec STOP = Spec 0x00 0 0 Nothing 271 | spec ADD = Spec 0x01 2 1 Nothing 272 | spec MUL = Spec 0x02 2 1 Nothing 273 | spec SUB = Spec 0x03 2 1 Nothing 274 | spec DIV = Spec 0x04 2 1 Nothing 275 | spec SDIV = Spec 0x05 2 1 Nothing 276 | spec MOD = Spec 0x06 2 1 Nothing 277 | spec SMOD = Spec 0x07 2 1 Nothing 278 | spec ADDMOD = Spec 0x08 3 1 Nothing 279 | spec MULMOD = Spec 0x09 3 1 Nothing 280 | spec EXP = Spec 0x0a 2 1 Nothing 281 | spec SIGNEXTEND = Spec 0x0b 2 1 Nothing 282 | spec LT = Spec 0x10 2 1 Nothing 283 | spec GT = Spec 0x11 2 1 Nothing 284 | spec SLT = Spec 0x12 2 1 Nothing 285 | spec SGT = Spec 0x13 2 1 Nothing 286 | spec EQ = Spec 0x14 2 1 Nothing 287 | spec ISZERO = Spec 0x15 1 1 Nothing 288 | spec AND = Spec 0x16 2 1 Nothing 289 | spec OR = Spec 0x17 2 1 Nothing 290 | spec XOR = Spec 0x18 2 1 Nothing 291 | spec NOT = Spec 0x19 1 1 Nothing 292 | spec BYTE = Spec 0x1a 2 1 Nothing 293 | spec SHA3 = Spec 0x20 2 1 Nothing 294 | spec ADDRESS = Spec 0x30 0 1 Nothing 295 | spec BALANCE = Spec 0x31 1 1 Nothing 296 | spec ORIGIN = Spec 0x32 0 1 Nothing 297 | spec CALLER = Spec 0x33 0 1 Nothing 298 | spec CALLVALUE = Spec 0x34 0 1 Nothing 299 | spec CALLDATALOAD = Spec 0x35 1 1 Nothing 300 | spec CALLDATASIZE = Spec 0x36 0 1 Nothing 301 | spec CALLDATACOPY = Spec 0x37 3 0 Nothing 302 | spec CODESIZE = Spec 0x38 0 1 Nothing 303 | spec CODECOPY = Spec 0x39 3 0 Nothing 304 | spec GASPRICE = Spec 0x3a 0 1 Nothing 305 | spec EXTCODESIZE = Spec 0x3b 1 1 Nothing 306 | spec EXTCODECOPY = Spec 0x3c 4 0 Nothing 307 | spec BLOCKHASH = Spec 0x40 1 1 Nothing 308 | spec COINBASE = Spec 0x41 0 1 Nothing 309 | spec TIMESTAMP = Spec 0x42 0 1 Nothing 310 | spec NUMBER = Spec 0x43 0 1 Nothing 311 | spec DIFFICULTY = Spec 0x44 0 1 Nothing 312 | spec GASLIMIT = Spec 0x45 0 1 Nothing 313 | spec POP = Spec 0x50 1 0 Nothing 314 | spec MLOAD = Spec 0x51 1 1 Nothing 315 | spec MSTORE = Spec 0x52 2 0 Nothing 316 | spec MSTORE8 = Spec 0x53 2 0 Nothing 317 | spec SLOAD = Spec 0x54 1 1 Nothing 318 | spec SSTORE = Spec 0x55 2 0 Nothing 319 | spec JUMP = Spec 0x56 1 0 Nothing 320 | spec JUMPI = Spec 0x57 2 0 Nothing 321 | spec PC = Spec 0x58 0 1 Nothing 322 | spec MSIZE = Spec 0x59 0 1 Nothing 323 | spec GAS = Spec 0x5a 0 1 Nothing 324 | spec JUMPDEST = Spec 0x5b 0 0 Nothing 325 | spec PUSH1 = Spec 96 0 1 (Just $ PushW 1) 326 | spec PUSH2 = Spec 97 0 1 (Just $ PushW 2) 327 | spec PUSH3 = Spec 98 0 1 (Just $ PushW 3) 328 | spec PUSH4 = Spec 99 0 1 (Just $ PushW 4) 329 | spec PUSH5 = Spec 100 0 1 (Just $ PushW 5) 330 | spec PUSH6 = Spec 101 0 1 (Just $ PushW 6) 331 | spec PUSH7 = Spec 102 0 1 (Just $ PushW 7) 332 | spec PUSH8 = Spec 103 0 1 (Just $ PushW 8) 333 | spec PUSH9 = Spec 104 0 1 (Just $ PushW 9) 334 | spec PUSH10 = Spec 105 0 1 (Just $ PushW 10) 335 | spec PUSH11 = Spec 106 0 1 (Just $ PushW 11) 336 | spec PUSH12 = Spec 107 0 1 (Just $ PushW 12) 337 | spec PUSH13 = Spec 108 0 1 (Just $ PushW 13) 338 | spec PUSH14 = Spec 109 0 1 (Just $ PushW 14) 339 | spec PUSH15 = Spec 110 0 1 (Just $ PushW 15) 340 | spec PUSH16 = Spec 111 0 1 (Just $ PushW 16) 341 | spec PUSH17 = Spec 112 0 1 (Just $ PushW 17) 342 | spec PUSH18 = Spec 113 0 1 (Just $ PushW 18) 343 | spec PUSH19 = Spec 114 0 1 (Just $ PushW 19) 344 | spec PUSH20 = Spec 115 0 1 (Just $ PushW 20) 345 | spec PUSH21 = Spec 116 0 1 (Just $ PushW 21) 346 | spec PUSH22 = Spec 117 0 1 (Just $ PushW 22) 347 | spec PUSH23 = Spec 118 0 1 (Just $ PushW 23) 348 | spec PUSH24 = Spec 119 0 1 (Just $ PushW 24) 349 | spec PUSH25 = Spec 120 0 1 (Just $ PushW 25) 350 | spec PUSH26 = Spec 121 0 1 (Just $ PushW 26) 351 | spec PUSH27 = Spec 122 0 1 (Just $ PushW 27) 352 | spec PUSH28 = Spec 123 0 1 (Just $ PushW 28) 353 | spec PUSH29 = Spec 124 0 1 (Just $ PushW 29) 354 | spec PUSH30 = Spec 125 0 1 (Just $ PushW 30) 355 | spec PUSH31 = Spec 126 0 1 (Just $ PushW 31) 356 | spec PUSH32 = Spec 127 0 1 (Just $ PushW 32) 357 | spec DUP1 = Spec 128 0 1 (Just $ Dup 1) 358 | spec DUP2 = Spec 129 0 1 (Just $ Dup 2) 359 | spec DUP3 = Spec 130 0 1 (Just $ Dup 3) 360 | spec DUP4 = Spec 131 0 1 (Just $ Dup 4) 361 | spec DUP5 = Spec 132 0 1 (Just $ Dup 5) 362 | spec DUP6 = Spec 133 0 1 (Just $ Dup 6) 363 | spec DUP7 = Spec 134 0 1 (Just $ Dup 7) 364 | spec DUP8 = Spec 135 0 1 (Just $ Dup 8) 365 | spec DUP9 = Spec 136 0 1 (Just $ Dup 9) 366 | spec DUP10 = Spec 137 0 1 (Just $ Dup 10) 367 | spec DUP11 = Spec 138 0 1 (Just $ Dup 11) 368 | spec DUP12 = Spec 139 0 1 (Just $ Dup 12) 369 | spec DUP13 = Spec 140 0 1 (Just $ Dup 13) 370 | spec DUP14 = Spec 141 0 1 (Just $ Dup 14) 371 | spec DUP15 = Spec 142 0 1 (Just $ Dup 15) 372 | spec DUP16 = Spec 143 0 1 (Just $ Dup 16) 373 | spec SWAP1 = Spec 144 0 1 (Just $ Swap 1) 374 | spec SWAP2 = Spec 145 0 1 (Just $ Swap 2) 375 | spec SWAP3 = Spec 146 0 1 (Just $ Swap 3) 376 | spec SWAP4 = Spec 147 0 1 (Just $ Swap 4) 377 | spec SWAP5 = Spec 148 0 1 (Just $ Swap 5) 378 | spec SWAP6 = Spec 149 0 1 (Just $ Swap 6) 379 | spec SWAP7 = Spec 150 0 1 (Just $ Swap 7) 380 | spec SWAP8 = Spec 151 0 1 (Just $ Swap 8) 381 | spec SWAP9 = Spec 152 0 1 (Just $ Swap 9) 382 | spec SWAP10 = Spec 153 0 1 (Just $ Swap 10) 383 | spec SWAP11 = Spec 154 0 1 (Just $ Swap 11) 384 | spec SWAP12 = Spec 155 0 1 (Just $ Swap 12) 385 | spec SWAP13 = Spec 156 0 1 (Just $ Swap 13) 386 | spec SWAP14 = Spec 157 0 1 (Just $ Swap 14) 387 | spec SWAP15 = Spec 158 0 1 (Just $ Swap 15) 388 | spec SWAP16 = Spec 159 0 1 (Just $ Swap 16) 389 | spec LOG0 = Spec 0xa0 2 1 (Just $ Log 0) 390 | spec LOG1 = Spec 0xa1 3 1 (Just $ Log 1) 391 | spec LOG2 = Spec 0xa2 4 1 (Just $ Log 2) 392 | spec LOG3 = Spec 0xa3 5 1 (Just $ Log 3) 393 | spec LOG4 = Spec 0xa4 6 1 (Just $ Log 4) 394 | spec CREATE = Spec 0xf0 3 1 Nothing 395 | spec CALL = Spec 0xf1 7 1 Nothing 396 | spec CALLCODE = Spec 0xf2 7 1 Nothing 397 | spec RETURN = Spec 0xf3 2 0 Nothing 398 | spec SUICIDE = Spec 0xff 1 0 Nothing 399 | -------------------------------------------------------------------------------- /src/Masala/RPC.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE ConstraintKinds #-} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE DeriveGeneric #-} 7 | 8 | -- | Supports a subset of Eth RPC, namely eth_call and eth_sendTransaction 9 | module Masala.RPC where 10 | 11 | 12 | import Data.Aeson hiding ((.=)) 13 | import qualified Data.Aeson as A ((.=)) 14 | import Data.Aeson.Types (fieldLabelModifier,Parser) 15 | import Control.Monad.Except 16 | import qualified Data.Text as T 17 | import qualified Data.Char as C 18 | import qualified Data.HashMap.Strict as HM 19 | import GHC.Generics 20 | import Masala.Word 21 | import Masala.Instruction 22 | import Masala.VM.Types 23 | import Masala.VM 24 | import Control.Monad.State.Strict 25 | import Data.Maybe 26 | import qualified Data.Vector as V 27 | import Masala.Ext.Simple 28 | 29 | -- | Monad maintains RPC state as the environment for the VM, 30 | -- wrapping the 'MonadExt' implementation. 31 | type RPC = ExceptT String (StateT Env MExt) 32 | 33 | 34 | -- | Nice type for RPC, should be in VM.Types most likely. 35 | newtype WordArray = WordArray { getWords :: [U8] } 36 | deriving (Eq,Generic) 37 | instance FromJSON WordArray where 38 | parseJSON = withText "WordArray" 39 | (\t -> case readHexs (drop 2 $ T.unpack t) of 40 | Right a -> return (WordArray a) 41 | Left err -> fail err) 42 | instance Show WordArray where show (WordArray a) = "0x" ++ concatMap showHexPad a 43 | 44 | 45 | parseDropPfxJSON :: (GFromJSON Zero (Rep a), Generic a) => Int -> Value -> Parser a 46 | parseDropPfxJSON n = genericParseJSON (defaultOptions { fieldLabelModifier = drop n }) 47 | 48 | 49 | data RPCall = 50 | Eth_accounts | 51 | Eth_blockNumber | 52 | Eth_getBalance | 53 | Eth_protocolVersion | 54 | Eth_coinbase | 55 | Eth_mining | 56 | Eth_gasPrice | 57 | Eth_getStorage | 58 | Eth_storageAt | 59 | Eth_getStorageAt | 60 | Eth_getTransactionCount | 61 | Eth_getBlockTransactionCountByHash | 62 | Eth_getBlockTransactionCountByNumber | 63 | Eth_getUncleCountByBlockHash | 64 | Eth_getUncleCountByBlockNumber | 65 | Eth_getData | 66 | Eth_getCode | 67 | Eth_sign | 68 | Eth_sendRawTransaction | 69 | Eth_sendTransaction | 70 | Eth_transact | 71 | Eth_estimateGas | 72 | Eth_call | 73 | Eth_flush | 74 | Eth_getBlockByHash | 75 | Eth_getBlockByNumber | 76 | Eth_getTransactionByHash | 77 | Eth_getTransactionByBlockNumberAndIndex | 78 | Eth_getTransactionByBlockHashAndIndex | 79 | Eth_getUncleByBlockHashAndIndex | 80 | Eth_getUncleByBlockNumberAndIndex | 81 | Eth_getCompilers | 82 | Eth_compileSolidity | 83 | Eth_newFilter | 84 | Eth_newBlockFilter | 85 | Eth_newPendingTransactionFilter | 86 | Eth_uninstallFilter | 87 | Eth_getFilterChanges | 88 | Eth_getFilterLogs | 89 | Eth_getLogs | 90 | Eth_hashrate | 91 | Eth_getWork | 92 | Eth_submitWork | 93 | Eth_submitHashrate | 94 | Eth_resend | 95 | Eth_pendingTransactions | 96 | Eth_getTransactionReceipt 97 | deriving (Eq,Enum,Bounded,Show) 98 | 99 | 100 | 101 | data SendTran = SendTran { 102 | stfrom :: Address, -- The address the transaction is send from. 103 | stto :: Maybe Address, -- (optional when creating new contract) The address the transaction is directed to. 104 | stgas :: Maybe U256, -- (optional, default: 90000) Integer of the gas provided for the transaction execution. It will return unused gas. 105 | stgasPrice :: Maybe U256, -- (optional, default: To-Be-Determined) Integer of the gasPrice used for each paid gas 106 | stvalue :: Maybe U256, -- (optional) Integer of the value send with this transaction 107 | stdata :: Maybe WordArray, -- (optional) The compiled code of a contract 108 | stnonce :: Maybe U256 -- (optional) Integer of a nonce. This allows to overwrite your own pending transactions that use the same nonce. 109 | } deriving (Generic,Show) 110 | 111 | instance FromJSON SendTran where parseJSON = parseDropPfxJSON 2 112 | 113 | data EthCall = EthCall { 114 | cfrom :: Maybe Address, -- (optional) The address the transaction is send from. 115 | cto :: Address, -- The address the transaction is directed to. 116 | cgas :: Maybe U256, -- (optional) Integer of the gas provided for the transaction execution. eth_call consumes zero gas, but this parameter may be needed by some executions. 117 | cgasPrice :: Maybe U256, -- (optional) Integer of the gasPrice used for each paid gas 118 | cvalue :: Maybe U256, -- (optional) Integer of the value send with this transaction 119 | cdata :: Maybe WordArray -- (optional) The compiled code of a contract 120 | -- cblockno :: U256 -- integer block number, or the string "latest", "earliest" or "pending", see the default block parameter TODO 121 | } deriving (Generic,Show) 122 | 123 | instance FromJSON EthCall where parseJSON = parseDropPfxJSON 1 124 | 125 | rpcs :: HM.HashMap String RPCall 126 | rpcs = foldl (\m r -> HM.insert (lc1 (show r)) r m) HM.empty [minBound..maxBound] 127 | where lc1 (c:cs) = C.toLower c:cs 128 | lc1 _ = error "rpcs: bug" 129 | 130 | -- | run RPC monad. 131 | runRPC :: String -> [Value] -> RPC Value 132 | runRPC c v = do 133 | rpc <- maybe (throwError $ "Invalid RPC: " ++ c) return $ HM.lookup c rpcs 134 | dispatchRPC rpc v 135 | 136 | -- | Fire up backend, run RPC in it. 137 | runRPCIO :: ExtData -> Env -> String -> [Value] -> IO (Value,Env,ExtData) 138 | runRPCIO e s c v = do 139 | (r,e') <- runMExt (runStateT (runExceptT (runRPC c v)) s) e 140 | case r of 141 | (Left err,s') -> return (object ["error" A..= err], s',e') 142 | (Right o,s') -> return (o,s',e') 143 | 144 | 145 | -- | Dispatch. 146 | dispatchRPC :: RPCall -> [Value] -> RPC Value 147 | dispatchRPC Eth_sendTransaction [a] = arg a >>= sendTransaction 148 | dispatchRPC Eth_call [a,b] = arg2 a b >>= uncurry ethCall 149 | dispatchRPC m a = throwError $ "Unsupported RPC: " ++ show m ++ ", " ++ show a 150 | 151 | arg :: (FromJSON a) => Value -> RPC a 152 | arg v = case fromJSON v of 153 | Error err -> throwError $ "JSON parse failure: " ++ err 154 | Success a -> return a 155 | 156 | arg2 :: (FromJSON a, FromJSON b) => Value -> Value -> RPC (a,b) 157 | arg2 a b = (,) <$> arg a <*> arg b 158 | 159 | 160 | 161 | ethCall :: EthCall -> U256 -> RPC Value 162 | ethCall m@(EthCall fromA toA callgas gasPx callvalue sdata) _blockNo = do -- blockNo TODO 163 | liftIO $ putStrLn $ "ethCall: " ++ show m -- TODO handle as "debug" 164 | acctm <- extAddress toA 165 | case acctm of 166 | Nothing -> throwError $ "ethCall: Bad address: " ++ show m 167 | Just acct -> do 168 | o <- callVM (fromMaybe toA fromA) toA callgas gasPx callvalue (_acctCode acct) (maybe [] getWords sdata) 169 | liftIO $ putStrLn $ "call: Success, output=" ++ showHexs o 170 | return $ String $ T.pack $ showHexs o -- TODO need toJSON 171 | 172 | 173 | 174 | sendTransaction :: SendTran -> RPC Value 175 | sendTransaction m@(SendTran fromA toA callgas gasPx callvalue sdata _nonce) = do 176 | liftIO $ putStrLn $ "sendTransaction: " ++ show m -- TODO handle as "debug" 177 | (addr,acode) <- 178 | case toA of 179 | Nothing -> do 180 | acct <- extCreate 0 181 | let ad = _acctAddress acct 182 | c = maybe [] getWords sdata 183 | return (ad,c) 184 | Just t -> do 185 | acctm <- extAddress t 186 | case acctm of 187 | Nothing -> error "Bad address" -- TODO, ExtOp should support MonadError 188 | Just acct -> return (_acctAddress acct,_acctCode acct) 189 | liftIO $ print (addr,acode) 190 | o <- callVM fromA addr callgas gasPx callvalue acode [] -- TODO, trans may also accept ABI 191 | when (isNothing toA) $ extSaveCode addr o 192 | acct' <- extAddress addr 193 | liftIO $ putStrLn $ "sendTransaction: Success, addr=" ++ show addr ++ ", output=" ++ show o 194 | return $ String $ T.pack $ "Success, addr=" ++ show addr ++ ", acct=" ++ show acct' 195 | 196 | 197 | 198 | 199 | -- | Call into VM from RPC. 200 | callVM :: Address -> Address -> Maybe U256 -> Maybe U256 -> Maybe U256 -> [U8] -> [U8] -> RPC [U8] 201 | callVM toA fromA callgas gasPx callvalue ccode cdata' = do 202 | env <- get 203 | let cgas' = fromMaybe 90000 callgas 204 | env' = env { 205 | _caller = fromA, 206 | _origin = fromA, 207 | _address = toA, 208 | _envGas = cgas', -- TODO, not sure what env gas is ... 209 | _callValue = fromMaybe 0 callvalue, 210 | _gasPrice = fromMaybe 0 gasPx, 211 | _callData = V.fromList cdata', 212 | _prog = toProg (concatMap toByteCode . parse $ ccode) 213 | } 214 | vmstate = emptyState (fromIntegral cgas') 215 | liftIO $ putStrLn $ "callVM: " ++ show vmstate ++ ", " ++ show cgas' 216 | r <- launchVM vmstate env' Nothing -- TODO, this should be asynchronous, returning "transaction hash" 217 | case r of 218 | (Left s,_) -> throwError $ "ERROR in callVM: " ++ s 219 | (Right vr, _vs) -> case vr of 220 | Final o -> do 221 | liftIO $ putStrLn $ "call: Success, output=" ++ showHexs o 222 | put env' 223 | return o 224 | er -> error $ "callVM: result not final: " ++ show er 225 | -------------------------------------------------------------------------------- /src/Masala/Repl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | -- | Provides a REPL, as well as the shape needed to host the VM in Juno. 5 | module Masala.Repl where 6 | 7 | import Masala.RPC 8 | import Masala.Ext.Simple 9 | import Data.IORef 10 | import Data.Aeson 11 | import qualified Data.ByteString.Lazy.Char8 as LBS 12 | import GHC.Generics 13 | import qualified Data.Map.Strict as M 14 | import qualified Data.Set as S 15 | import qualified Data.Vector as V 16 | import Masala.VM.Types 17 | import Masala.VM 18 | import Control.Exception 19 | import qualified Data.Text as T 20 | import Masala.Word 21 | import Masala.VM.Dispatch (sha3) 22 | import Data.Char 23 | import Control.Monad 24 | import System.IO 25 | 26 | data RPCCmd = RPCCmd { method :: String, params :: [Value] } deriving (Generic,Show) 27 | instance FromJSON RPCCmd 28 | 29 | type RPCState = (Env,ExtData) 30 | 31 | initRPCState :: RPCState 32 | initRPCState = (Env EthGasModel calldata (toProg []) (_acctAddress acc) 33 | addr 34 | addr 35 | 0 0 0 0 0 0 0 0 0, 36 | ex) 37 | where addr = 123456 38 | acc = ExtAccount [] 0 addr M.empty 39 | ex = ExtData (M.fromList [(addr,acc)]) S.empty S.empty M.empty [] dbug 40 | calldata = V.fromList [0,1,2,3,4] 41 | dbug = True 42 | 43 | 44 | runEvmRPC :: IORef RPCState -> String -> IO String 45 | runEvmRPC ior cmd = do 46 | ve :: Either String RPCCmd <- return $ eitherDecode (LBS.pack cmd) 47 | case ve of 48 | Left err -> return $ "runEvmRPC: invalid JSON: " ++ err 49 | Right (RPCCmd meth pms) -> do 50 | s@(e,d) <- readIORef ior 51 | (v,e',d') <- catch (runRPCIO d e meth pms) (catchErr s) 52 | writeIORef ior (e',d') 53 | return (LBS.unpack $ encode v) 54 | 55 | catchErr :: RPCState -> SomeException -> IO (Value,Env,ExtData) 56 | catchErr (env,ext) e = return (object ["error" .= T.pack ("Exception occured: " ++ show e)],env,ext) 57 | 58 | _runRPC :: String -> IO String 59 | _runRPC s = do 60 | r <- newIORef initRPCState 61 | runEvmRPC r s 62 | 63 | strToSha3 :: String -> U256 64 | strToSha3 = sha3 . map (fromIntegral . ord) 65 | 66 | abiZero :: U256 -> U256 67 | abiZero a = a .&. (0xffffffff `shiftL` 224) 68 | 69 | repl :: IO () 70 | repl = do 71 | r <- newIORef initRPCState 72 | forever $ do 73 | putStr "> "; hFlush stdout 74 | inp <- getLine 75 | o <- runEvmRPC r inp 76 | putStrLn o; hFlush stdout 77 | 78 | -- | Basic RPC ABI conversion. 79 | abi :: String -> [U256] -> String 80 | abi fn args = show (abiZero (strToSha3 fn)) ++ concatMap hex32 args 81 | where hex32 = reverse . take 8 . (++ cycle "0") . reverse . showHex 82 | -------------------------------------------------------------------------------- /src/Masala/VM.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | 9 | -- | Interpreter and trampoline for EVM. 10 | module Masala.VM where 11 | 12 | import Control.Monad.Reader 13 | import Control.Monad.State.Strict 14 | import Control.Lens hiding (op) 15 | import Masala.Instruction 16 | import Masala.Word 17 | import qualified Data.Vector as V 18 | import Prelude hiding (LT,GT,EQ,log) 19 | import qualified Data.Map.Strict as M 20 | import Masala.Ext.Simple 21 | import qualified Data.Set as S 22 | import Masala.VM.Types 23 | import Masala.VM.Dispatch 24 | import Masala.VM.Memory 25 | import Masala.VM.Gas 26 | 27 | 28 | -- | convert bytecodes to internal type. 29 | toProg :: [ByteCode] -> Prog 30 | toProg bc = Prog (V.fromList bc) (M.fromList (zipWith idx [0..] bc)) 31 | where idx c (ByteCode n _ _) = (fromIntegral n,c) 32 | 33 | -- | Step program counter forward. 34 | forward :: Monad m => VM m Bool 35 | forward = do 36 | c <- use ctr 37 | (Prog p _) <- view prog 38 | if c + 1 >= V.length p 39 | then return False 40 | else do 41 | ctr .= c + 1 42 | return True 43 | 44 | emptyState :: Gas -> VMState 45 | emptyState = VMState [] 0 M.empty 46 | 47 | launchVM :: MonadExt m => VMState -> Env -> Maybe Resume -> m (Either String VMResult, VMState) 48 | launchVM vm env callR = runVM vm env (stepVM callR) >>= postEx env 49 | 50 | -- | Handle post-execution, which might trampoline into a Call. 51 | postEx :: MonadExt m => Env -> (Either String VMResult, VMState) -> m (Either String VMResult, VMState) 52 | postEx _ l@(Left _,_) = return l 53 | postEx _ r@(Right (Final {}),_) = return r 54 | postEx env (Right (Call g addr codes _glimit cdata action), vm) = do 55 | let parsedcode = parse codes 56 | case parsedcode of 57 | Left e -> return (Left e,vm) 58 | Right prog' -> do 59 | let env' = set prog (toProg prog') . 60 | set address (_acctAddress addr) . 61 | set caller (view address env) . 62 | set callData (V.fromList cdata) $ env 63 | r <- launchVM (emptyState (fromIntegral g)) env' Nothing 64 | case r of 65 | (Left _,_) -> return r 66 | (Right (Call {}),v) -> return $ (Left $ "VM mrror: Call returned from 'runVM': " ++ show r,v) 67 | (Right (Final o),vm') -> 68 | launchVM vm' env (Just $ Resume 1 o action) 69 | 70 | 71 | -- | Take a step. 72 | stepVM :: (MonadExt m) => Maybe Resume -> VM m VMResult 73 | stepVM r = do 74 | let done ws = do 75 | get >>= \s -> extDebug $ show (ws,s) 76 | return (Final ws) 77 | cf <- case r of 78 | Nothing -> exec 79 | (Just rs@(Resume p result action)) -> do 80 | extDebug $ "Resume: " ++ show rs 81 | case action of 82 | SaveMem loc len -> mstores loc 0 len result 83 | SaveCode addr -> extSaveCode addr result 84 | push p 85 | return Next 86 | case cf of 87 | Next -> do 88 | notDone <- forward 89 | if notDone 90 | then stepVM Nothing 91 | else done [] 92 | Jump c -> do 93 | ctr .= c 94 | stepVM Nothing 95 | Stop -> done [] 96 | Return ws -> done ws 97 | Yield call -> do 98 | extDebug $ "Yield: " ++ show call 99 | return call 100 | 101 | 102 | -- | Execute an opcode. Reads 'Spec' to determine argument count, 103 | -- pops that many args off stack, and dispatches. 104 | exec :: MonadExt m => VM m ControlFlow 105 | exec = do 106 | bc@(ByteCode _ i ws) <- current 107 | let (Spec _ stackin _ pspec) = spec i 108 | svals <- pops stackin 109 | debugOut bc svals 110 | gm <- view gasModel 111 | handleGas gm i pspec svals 112 | if null ws 113 | then dispatch i (pspec,svals) 114 | else mapM_ push (u8sToU256s ws) >> next 115 | 116 | 117 | debugOut :: (MonadExt m) => ByteCode -> [U256] -> VM m () 118 | debugOut i svals = do 119 | vm <- get 120 | extDebug $ show (i,svals,vm) 121 | 122 | 123 | ---- 124 | -- TESTING 125 | ---- 126 | 127 | run_ :: String -> IO ((Either String VMResult, VMState),ExtData) 128 | run_ = either error runBC_ . parseHex 129 | 130 | runBC_ :: ToByteCode a => [a] -> IO ((Either String VMResult, VMState),ExtData) 131 | runBC_ c = runVM_ c [0,1,2,3,4] 132 | 133 | runHex :: String -> String -> IO ((Either String VMResult, VMState),ExtData) 134 | runHex c d = runVM_ (either error id (parseHex c)) (either error id (readHexs d)) 135 | 136 | runVM_ :: ToByteCode a => [a] -> [U8] -> IO ((Either String VMResult, VMState),ExtData) 137 | runVM_ bc calld = flip runMExt ex $ launchVM (emptyState gas') 138 | (Env EthGasModel calldata 139 | (toProg tbc) 140 | (_acctAddress acc) 141 | addr 142 | addr 143 | 0 0 0 0 0 0 0 0 0) 144 | Nothing 145 | where tbc = concatMap toByteCode bc 146 | addr = 123456 147 | gas' = 10000000 148 | acc = ExtAccount (bcsToU8s tbc) 0 addr M.empty 149 | ex = ExtData (M.fromList [(addr,acc)]) S.empty S.empty M.empty [] True 150 | calldata = V.fromList calld 151 | -------------------------------------------------------------------------------- /src/Masala/VM/Dispatch.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | -- | Contains main dispatch switch and opcode implementations. 6 | module Masala.VM.Dispatch where 7 | 8 | import Masala.Instruction 9 | import Masala.Word 10 | import Masala.VM.Types 11 | import Masala.VM.Memory 12 | import Masala.VM.Gas 13 | import Control.Monad 14 | import Prelude hiding (LT,GT,EQ,log) 15 | import Control.Lens 16 | import Data.Maybe 17 | import qualified Data.Vector as V 18 | import qualified Data.Map.Strict as M 19 | import Control.Monad.Except 20 | import qualified Data.ByteArray as BA 21 | import Crypto.Hash 22 | 23 | infMod :: (Integer -> Integer -> Integer) -> U256 -> U256 -> U256 -> U256 24 | infMod f a b c = fromIntegral ((fromIntegral a `f` fromIntegral b) `mod` fromIntegral c) 25 | 26 | -- | Pattern-matches on opcode and number of arguments to evaluate. 27 | dispatch :: MonadExt m => Instruction -> (Maybe ParamSpec,[U256]) -> VM m ControlFlow 28 | dispatch STOP _ = return Stop 29 | dispatch ADD (_,[a,b]) = push (a + b) >> next 30 | dispatch MUL (_,[a,b]) = push (a * b) >> next 31 | dispatch SUB (_,[a,b]) = push (a - b) >> next 32 | dispatch DIV (_,[a,b]) = push (if b == 0 then 0 else a `div` b) >> next 33 | dispatch SDIV (_,[a,b]) = pushs (sgn a `sdiv` sgn b) >> next 34 | dispatch MOD (_,[a,b]) = push (if b == 0 then 0 else a `mod` b) >> next 35 | dispatch SMOD (_,[a,b]) = pushs (sgn a `smod` sgn b) >> next 36 | dispatch ADDMOD (_,[a,b,c]) = push (if c == 0 then 0 else infMod (+) a b c) >> next 37 | dispatch MULMOD (_,[a,b,c]) = push (if c == 0 then 0 else infMod (*) a b c) >> next 38 | dispatch EXP (_,[a,b]) = push (a ^ b) >> next 39 | dispatch SIGNEXTEND (_,[a,b]) = push (int a `signextend` b) >> next 40 | dispatch LT (_,[a,b]) = pushb (a < b) >> next 41 | dispatch GT (_,[a,b]) = pushb (a > b) >> next 42 | dispatch SLT (_,[a,b]) = pushb (sgn a < sgn b) >> next 43 | dispatch SGT (_,[a,b]) = pushb (sgn a > sgn b) >> next 44 | dispatch EQ (_,[a,b]) = pushb (a == b) >> next 45 | dispatch ISZERO (_,[a]) = pushb (a == 0) >> next 46 | dispatch AND (_,[a,b]) = push (a .&. b) >> next 47 | dispatch OR (_,[a,b]) = push (a .|. b) >> next 48 | dispatch XOR (_,[a,b]) = push (a `xor` b) >> next 49 | dispatch NOT (_,[a]) = push (complement a) >> next 50 | dispatch BYTE (_,[a,b]) = push (int a `byte` b) >> next 51 | dispatch SHA3 (_,[a,b]) = sha3 <$> mloads a b >>= push >> next 52 | dispatch ADDRESS _ = view address >>= push . fromIntegral >> next 53 | dispatch BALANCE (_,[a]) = maybe 0 (fromIntegral . view acctBalance) <$> addy (toAddress a) >>= push >> next 54 | dispatch ORIGIN _ = view origin >>= push . fromIntegral >> next 55 | dispatch CALLER _ = view caller >>= push . fromIntegral >> next 56 | dispatch CALLVALUE _ = view callValue >>= push >> next 57 | dispatch CALLDATALOAD (_,[a]) = callDataLoad a >>= push >> next 58 | dispatch CALLDATASIZE _ = fromIntegral . V.length <$> view callData >>= push >> next 59 | dispatch CALLDATACOPY (_,[a,b,c]) = V.toList <$> view callData >>= 60 | mstores a b c >> next 61 | dispatch CODESIZE _ = fromIntegral . length . bcsToU8s . V.toList . pCode <$> view prog >>= push >> next 62 | dispatch CODECOPY (_,[a,b,c]) = bcsToU8s . V.toList . pCode <$> view prog >>= 63 | codeCopy a b c >> next 64 | dispatch GASPRICE _ = view gasPrice >>= push >> next 65 | dispatch EXTCODESIZE (_,[a]) = 66 | maybe 0 (fromIntegral . length . view acctCode) <$> addy (toAddress a) >>= push >> next 67 | dispatch EXTCODECOPY (_,[a,b,c,d]) = 68 | maybe (bcsToU8s $ toByteCode STOP) (view acctCode) <$> addy (toAddress a) >>= 69 | codeCopy b c d >> next 70 | dispatch BLOCKHASH (_,[a]) = view number >>= blockHash a >>= push >> next 71 | dispatch COINBASE _ = view coinbase >>= push >> next 72 | dispatch TIMESTAMP _ = view timestamp >>= push >> next 73 | dispatch NUMBER _ = view number >>= push >> next 74 | dispatch DIFFICULTY _ = view difficulty >>= push >> next 75 | dispatch GASLIMIT _ = fromIntegral <$> view gaslimit >>= push >> next 76 | dispatch POP _ = next -- exec already pops 1 per spec 77 | dispatch MLOAD (_,[a]) = mload a >>= push >> next 78 | dispatch MSTORE (_,[a,b]) = mstore a b >> next 79 | dispatch MSTORE8 (_,[a,b]) = mstore8 (fromIntegral a) (fromIntegral b) >> next 80 | dispatch SLOAD (_,[a]) = sload a >>= push >> next 81 | dispatch SSTORE (_,[a,b]) = sstore a b >> next 82 | dispatch JUMP (_,[a]) = jump a 83 | dispatch JUMPI (_,[a,b]) = if b /= 0 then jump a else next 84 | dispatch PC _ = fromIntegral . bcIdx <$> current >>= push >> next 85 | dispatch MSIZE _ = msize >>= push >> next 86 | dispatch GAS _ = fromIntegral <$> use gas >>= push >> next 87 | dispatch JUMPDEST _ = next -- per spec: "Mark a valid destination for jumps." 88 | -- "This operation has no effect on machine state during execution." 89 | dispatch _ (Just (Dup n),_) = dup n >> next 90 | dispatch _ (Just (Swap n),_) = swap n >> next 91 | dispatch _ (Just (Log n),args) = log n args >> next 92 | dispatch CREATE (_,[a,b,c]) = create (fromIntegral a) b (fromIntegral c) 93 | dispatch CALL (_,[g,t,gl,io,il,oo,ol]) = 94 | let a = toAddress t in 95 | doCall (fromIntegral g) a a (fromIntegral gl) io il oo ol 96 | dispatch CALLCODE (_,[g,t,gl,io,il,oo,ol]) = 97 | view address >>= \a -> 98 | doCall (fromIntegral g) a (toAddress t) (fromIntegral gl) io il oo ol 99 | dispatch RETURN (_,[a,b]) = Return <$> mloads a b 100 | dispatch SUICIDE (_,[a]) = suicide (toAddress a) 101 | dispatch i ps = err $ "Unsupported operation/arity/spec: " ++ show i ++ ", " ++ show ps 102 | 103 | callDataLoad :: Monad m => U256 -> VM m U256 104 | callDataLoad i = do 105 | cd <- view callData 106 | if i > fromIntegral (V.length cd) 107 | then return 0 108 | else do 109 | let check [] = 0 110 | check (a:_) = a 111 | return . check . u8sToU256s . map (fromMaybe 0 . (cd V.!?)) $ [fromIntegral i .. fromIntegral i+31] 112 | 113 | 114 | next :: Monad m => VM m ControlFlow 115 | next = return Next 116 | 117 | pushb :: Monad m => Bool -> VM m () 118 | pushb b = push $ if b then 1 else 0 119 | 120 | sgn :: U256 -> S256 121 | sgn = fromIntegral 122 | 123 | pushs :: Monad m => S256 -> VM m () 124 | pushs = push . fromIntegral 125 | 126 | int :: Integral a => a -> Int 127 | int = fromIntegral 128 | 129 | jump :: Monad m => U256 -> VM m ControlFlow 130 | jump j = do 131 | bc <- M.lookup j . pCodeMap <$> view prog 132 | case bc of 133 | Nothing -> err $ "jump: invalid address " ++ show j 134 | Just c -> return (Jump c) 135 | 136 | codeCopy :: Monad m => U256 -> U256 -> U256 -> [U8] -> VM m () 137 | codeCopy memloc codeoff len codes 138 | | codeoff +^ len > fromIntegral (length codes) = return () 139 | | otherwise = mstores memloc 0 (fromIntegral $ length us) us 140 | where us = take (fromIntegral len) . drop (fromIntegral codeoff) $ codes 141 | 142 | lookupAcct :: MonadExt m => String -> Address -> VM m ExtAccount 143 | lookupAcct msg addr = do 144 | l <- extAddress addr 145 | maybe (throwError $ msg ++ ": " ++ show addr) return l 146 | 147 | doCall :: MonadExt m => Gas -> Address -> Address -> Gas -> 148 | U256 -> U256 -> U256 -> U256 -> VM m ControlFlow 149 | doCall cgas addr codeAddr cgaslimit inoff inlen outoff outlen = do 150 | d <- mloads inoff inlen 151 | codes <- view acctCode <$> lookupAcct "doCall: invalid code acct" codeAddr 152 | acct <- lookupAcct "doCall: invalid recipient acct" addr 153 | return $ Yield Call { cGas = cgas, cAcct = acct, cCode = codes, cGasLimit = cgaslimit, 154 | cData = d, cAction = SaveMem outoff outlen } 155 | 156 | create :: MonadExt m => Gas -> U256 -> U256 -> VM m ControlFlow 157 | create cgas codeloc codeoff = do 158 | codes <- mloads codeloc codeoff 159 | newaddy <- extCreate cgas 160 | deductGas cgas 161 | gl <- view gaslimit 162 | return $ Yield Call { cGas = cgas, cAcct = newaddy, cCode = codes, cGasLimit = gl, 163 | cData = [], cAction = SaveCode (view acctAddress newaddy) } 164 | 165 | suicide :: MonadExt m => Address -> VM m ControlFlow 166 | suicide addr = do 167 | isNewSuicide <- extSuicide addr 168 | when isNewSuicide refundSuicide 169 | return Stop 170 | 171 | addy :: MonadExt m => Address -> VM m (Maybe ExtAccount) 172 | addy k = extAddress k 173 | 174 | 175 | -- TODO: C++ code (per tests) routinely masks after (t - 3) bits whereas this 176 | -- code seems to do the right thing per spec. 177 | signextend :: Int -> U256 -> U256 178 | signextend k v 179 | | k > 31 = v 180 | | otherwise = 181 | let t = (k * 8) + 7 182 | mask = ((1 :: U256) `shiftL` t) - 1 183 | in if v `testBit` t 184 | then v .|. complement mask 185 | else v .&. mask 186 | 187 | byte :: Int -> U256 -> U256 188 | byte p v 189 | | p > 31 = 0 190 | | otherwise = (v `shiftR` (8 * (31 - p))) .&. 0xff 191 | 192 | 193 | dup :: Monad m => Int -> VM m () 194 | dup n = stackAt (n - 1) >>= push 195 | 196 | stackAt :: Monad m => Int -> VM m U256 197 | stackAt n = do 198 | s <- firstOf (ix n) <$> use stack 199 | case s of 200 | Nothing -> err $ "stackAt " ++ show n ++ ": stack underflow" 201 | Just w -> return w 202 | 203 | swap :: Monad m => Int -> VM m () 204 | swap n = do 205 | s0 <- stackAt 0 206 | sn <- stackAt n 207 | stack %= set (ix 0) sn . set (ix n) s0 208 | 209 | log :: MonadExt m => Int -> [U256] -> VM m () 210 | log n (mstart:sz:topics) 211 | | length topics /= n = 212 | err $ "Dispatch error, LOG" ++ show n ++ " with " ++ show (length topics) ++ " topics" 213 | | otherwise = do 214 | a <- view address 215 | b <- view number 216 | d <- mloads mstart sz 217 | extLog $ LogEntry a b topics d 218 | log n ws = err $ "Dispatch error LOG" ++ show n ++ ", expected 3 args: " ++ show ws 219 | 220 | sdiv :: S256 -> S256 -> S256 221 | sdiv a b | b == 0 = 0 222 | | otherwise = (abs a `div` abs b) * (signum a * signum b) 223 | 224 | smod :: S256 -> S256 -> S256 225 | smod a b | b == 0 = 0 226 | | otherwise = (abs a `mod` abs b) * signum a 227 | 228 | 229 | err :: Monad m => String -> VM m a 230 | err msg = do 231 | idx <- use ctr 232 | bc <- current 233 | throwError $ msg ++ " (index " ++ show idx ++ 234 | ", value " ++ show bc ++ ")" 235 | 236 | current :: Monad m => VM m ByteCode 237 | current = do 238 | c <- use ctr 239 | (Prog p _) <- view prog 240 | return $ p V.! c 241 | 242 | push :: (Monad m) => U256 -> VM m () 243 | push i = stack %= (i:) 244 | 245 | pops :: (Monad m) => Int -> VM m [U256] 246 | pops n | n == 0 = return [] 247 | | otherwise = do 248 | s <- use stack 249 | if n > length s 250 | then err $ "Stack underflow, expected " ++ show n ++ ", found " ++ show (length s) 251 | else do 252 | stack .= drop n s 253 | return (take n s) 254 | 255 | 256 | 257 | sha3 :: [U8] -> U256 258 | sha3 = head . u8sToU256s . map fromIntegral . BA.unpack . 259 | (hash :: BA.Bytes -> Digest Keccak_256) . BA.pack . map fromIntegral 260 | 261 | blockHash :: Monad m => U256 -> U256 -> VM m U256 262 | blockHash n blocknum = return $ sha3 $ u256ToU8s (n + blocknum) 263 | -------------------------------------------------------------------------------- /src/Masala/VM/Gas.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | 3 | -- | Handles Eth-style gas computations, used by the standard gas model. 4 | module Masala.VM.Gas 5 | ( 6 | handleGas 7 | ,refund 8 | ,refundSuicide 9 | ,deductGas 10 | ) where 11 | 12 | import Masala.Word 13 | import Masala.VM.Types 14 | import Masala.VM.Memory 15 | import Masala.Instruction 16 | import qualified Data.Map as M 17 | import Prelude hiding (EQ,LT,GT) 18 | import Data.Maybe 19 | import Control.Lens 20 | import Control.Monad.Except 21 | 22 | -- | specify a stateful gas calculation 23 | data GasCalc = 24 | MemSize U256 | 25 | StoreOp { _gcStoreLoc :: U256, _gcStoreValue :: U256 } | 26 | GasCall { _gcCallMemSize :: U256, _gcCallAddy :: (Maybe Address) } 27 | deriving (Eq,Show) 28 | 29 | 30 | -- | Compute gas for instruction and deduct, throwing error if out of gas. 31 | -- | This is also where different gas models are handled. 32 | handleGas :: MonadExt m => GasModel -> Instruction -> Maybe ParamSpec -> [U256] -> VM m () 33 | handleGas (FixedGasModel g) _ _ _ = deductGas g 34 | handleGas _ i ps svs = do 35 | let (callg,a) = computeGas i (ps,svs) 36 | calcg <- 37 | case a of 38 | Nothing -> return 0 39 | (Just c) -> 40 | case c of 41 | (MemSize sz) -> computeMemGas sz 42 | (StoreOp loc off) -> computeStoreGas loc off 43 | (GasCall sz addr) -> (+) <$> computeMemGas sz 44 | <*> computeCallGas addr 45 | deductGas (calcg + callg) 46 | 47 | 48 | -- | deduct, throwing error if out of gas 49 | deductGas :: MonadExt m => Gas -> VM m () 50 | deductGas total = do 51 | pg <- use gas 52 | let gas' = pg - total 53 | if gas' < 0 54 | then do 55 | gas .= 0 56 | throwError $ "Out of gas, previous gas=" ++ show pg ++ 57 | ", required=" ++ show total ++ 58 | ", balance= " ++ show gas' 59 | else do 60 | extDebug $ "gas used: " ++ show total 61 | gas .= gas' 62 | 63 | 64 | computeMemGas :: Monad m => U256 -> VM m Gas 65 | computeMemGas newSzBytes = do 66 | let toWordSize v = (v + 31) `div` 32 67 | newSzWords = fromIntegral $ toWordSize newSzBytes 68 | fee s = ((s * s) `div` 512) + (s * gas_memory) 69 | oldSzWords <- fromIntegral <$> msize 70 | return $ if newSzWords > oldSzWords 71 | then fee newSzWords - fee oldSzWords 72 | else 0 73 | 74 | computeStoreGas :: MonadExt m => U256 -> U256 -> VM m Gas 75 | computeStoreGas l v' = do 76 | v <- sload l 77 | if v == 0 && v' /= 0 78 | then return gas_sset 79 | else if v /= 0 && v' == 0 80 | then refund gas_sclear >> return gas_sreset 81 | else return gas_sreset 82 | 83 | 84 | computeCallGas :: MonadExt m => Maybe Address -> VM m Gas 85 | computeCallGas Nothing = return 0 86 | computeCallGas (Just a) = do 87 | isNew <- extIsCreate a 88 | return $ if isNew then gas_callnewaccount else 0 89 | 90 | 91 | 92 | -- | refund to running account 93 | refund :: MonadExt m => Gas -> VM m () 94 | refund g = do 95 | a <- view address 96 | extRefund a g 97 | 98 | -- | refund on suicide 99 | refundSuicide :: MonadExt m => VM m () 100 | refundSuicide = refund gas_suicide 101 | 102 | computeGas :: Instruction -> (Maybe ParamSpec,[U256]) -> (Gas,Maybe GasCalc) 103 | computeGas i p = (\(g,c) -> (g + fgas,c)) $ iGas i p 104 | where fgas = fromMaybe 0 $ M.lookup i fixedGas 105 | 106 | memSize :: U256 -> U256 -> Maybe GasCalc 107 | memSize a b = Just $ MemSize (a + b) 108 | 109 | wordSize :: U256 -> Integer 110 | wordSize = fromIntegral . length . u256ToU8s 111 | 112 | callGas :: Instruction -> [U256] -> (Gas,Maybe GasCalc) 113 | callGas i [g,t,gl,io,il,oo,ol] = (fromIntegral g + (if gl > 0 then gas_callvalue else 0), 114 | Just (GasCall (io + il + oo + ol) 115 | (if i == CALL then Just (toAddress t) else Nothing))) 116 | callGas _ _ = (0,Nothing) -- errors caught in dispatch catch-all 117 | 118 | -- | dispatch to specify/compute gas 119 | iGas :: Instruction -> (Maybe ParamSpec,[U256]) -> (Gas,Maybe GasCalc) 120 | iGas _ (Just (Log n),[a,b]) = (gas_log + (fromIntegral n * gas_logtopic) + (fromIntegral b * gas_logdata), 121 | memSize a b) 122 | iGas EXP (_,[_a,b]) = (gas_exp + (wordSize b * gas_expbyte), Nothing) 123 | iGas SSTORE (_,[a,b]) = (0,Just $ StoreOp a b) 124 | iGas SUICIDE _ = (0,Nothing) -- refund will happen in execution 125 | iGas MLOAD (_,[a]) = (0,memSize a 32) 126 | iGas MSTORE (_,[a,_]) = (0,memSize a 32) 127 | iGas MSTORE8 (_,[a,_]) = (0,memSize a 1) 128 | iGas RETURN (_,[a,b]) = (0,memSize a b) 129 | iGas SHA3 (_,[a,b]) = (wordSize b * gas_sha3word,memSize a b) 130 | iGas CALLDATACOPY (_,[a,_b,c]) = (wordSize c * gas_copy,memSize a c) 131 | iGas CODECOPY (_,[a,_b,c]) = (wordSize c * gas_copy,memSize a c) 132 | iGas EXTCODECOPY (_,[_a,b,_c,d]) = (wordSize d * gas_copy,memSize b d) 133 | iGas CREATE (_,[_a,b,c]) = (0,memSize b c) 134 | iGas CALL (_,s) = callGas CALL s 135 | iGas CALLCODE (_,s) = callGas CALLCODE s 136 | iGas _ _ = (0,Nothing) -- errors caught in dispatch catch-all 137 | 138 | -- 139 | -- FIXED GAS COSTS, from yellow paper 140 | -- TODO these differ from the go code ... 141 | -- 142 | 143 | gasZero :: [Instruction] 144 | gasZero = [STOP 145 | , SUICIDE 146 | , RETURN] 147 | 148 | gasBase :: [Instruction] 149 | gasBase = [ADDRESS 150 | , ORIGIN 151 | , CALLER 152 | , CALLVALUE 153 | , CALLDATASIZE 154 | , CODESIZE 155 | , GASPRICE 156 | , COINBASE 157 | , TIMESTAMP 158 | , NUMBER 159 | , DIFFICULTY 160 | , GASLIMIT 161 | , POP 162 | , PC 163 | , MSIZE 164 | , GAS] 165 | 166 | gasVeryLow :: [Instruction] 167 | gasVeryLow = [ADD 168 | , SUB 169 | , NOT 170 | , LT 171 | , GT 172 | , SLT 173 | , SGT 174 | , EQ 175 | , ISZERO 176 | , AND 177 | , OR 178 | , XOR 179 | , BYTE 180 | , CALLDATALOAD 181 | , MLOAD 182 | , MSTORE 183 | , MSTORE8] 184 | ++ [PUSH1 .. PUSH32] 185 | ++ [DUP1 .. DUP16] 186 | ++ [SWAP1 .. SWAP16] 187 | 188 | gasLow :: [Instruction] 189 | gasLow = [MUL 190 | , DIV 191 | , SDIV 192 | , MOD 193 | , SMOD 194 | , SIGNEXTEND] 195 | 196 | gasMid :: [Instruction] 197 | gasMid = [ADDMOD 198 | , MULMOD 199 | , JUMP] 200 | 201 | gasHigh :: [Instruction] 202 | gasHigh = [JUMPI] 203 | 204 | gasExt :: [Instruction] 205 | gasExt = [BALANCE 206 | , EXTCODESIZE 207 | , BLOCKHASH] 208 | 209 | -- | Lookup for fixed gas costs. 210 | fixedGas :: M.Map Instruction Gas 211 | fixedGas = M.fromList $ 212 | map (,gas_zero) gasZero ++ 213 | map (,gas_base) gasBase ++ 214 | map (,gas_verylow) gasVeryLow ++ 215 | map (,gas_low) gasLow ++ 216 | map (,gas_mid) gasMid ++ 217 | map (,gas_high) gasHigh ++ 218 | map (,gas_ext) gasExt ++ 219 | [(SLOAD, gas_sload) 220 | ,(SHA3, gas_sha3) 221 | ,(CREATE,gas_create) 222 | ,(CALL,gas_call) 223 | ,(CALLCODE,gas_call) 224 | ,(JUMPDEST,gas_jumpdest)] 225 | 226 | -- 227 | -- GAS CONSTANTS from yellow paper 228 | -- 229 | 230 | gas_zero :: Gas; gas_zero = 0 231 | gas_base :: Gas; gas_base = 2 232 | gas_verylow :: Gas; gas_verylow = 3 233 | gas_low :: Gas; gas_low = 5 234 | gas_mid :: Gas; gas_mid = 8 235 | gas_high :: Gas; gas_high = 10 236 | gas_ext :: Gas; gas_ext = 20 237 | gas_sload :: Gas; gas_sload = 50 238 | gas_jumpdest :: Gas; gas_jumpdest = 1 239 | gas_sset :: Gas; gas_sset = 20000 240 | gas_sreset :: Gas; gas_sreset = 5000 241 | gas_sclear :: Gas; gas_sclear = 15000 242 | gas_suicide :: Gas; gas_suicide = 24000 243 | gas_create :: Gas; gas_create = 32000 244 | -- gas_codedeposit :: Gas; gas_codedeposit = 200 245 | gas_call :: Gas; gas_call = 40 246 | gas_callvalue :: Gas; gas_callvalue = 9000 247 | -- gas_callstipend :: Gas; gas_callstipend = 2300 248 | gas_callnewaccount :: Gas; gas_callnewaccount = 25000 249 | gas_exp :: Gas; gas_exp = 10 250 | gas_expbyte :: Gas; gas_expbyte = 10 251 | gas_memory :: Gas; gas_memory = 3 252 | -- gas_txdatazero :: Gas; gas_txdatazero = 4 253 | -- gas_txdatanonzero :: Gas; gas_txdatanonzero = 68 254 | -- gas_transaction :: Gas; gas_transaction = 21000 255 | gas_log :: Gas; gas_log = 375 256 | gas_logdata :: Gas; gas_logdata = 8 257 | gas_logtopic :: Gas; gas_logtopic = 375 258 | gas_sha3 :: Gas; gas_sha3 = 30 259 | gas_sha3word :: Gas; gas_sha3word = 6 260 | gas_copy :: Gas; gas_copy = 3 261 | -------------------------------------------------------------------------------- /src/Masala/VM/Memory.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | -- | Holds all memory operations. 4 | module Masala.VM.Memory where 5 | 6 | import Masala.VM.Types 7 | import Masala.Word 8 | import Data.Maybe 9 | import qualified Data.Map.Strict as M 10 | import Control.Lens 11 | 12 | mload :: Monad m => U256 -> VM m U256 13 | mload i | i +^ 31 <= i = return 0 14 | | otherwise = do 15 | m <- use mem 16 | return $ head . u8sToU256s . map (fromMaybe 0 . (`M.lookup` m)) $ [i .. i+31] 17 | 18 | 19 | mstore :: Monad m => U256 -> U256 -> VM m () 20 | mstore i v = mem %= M.union (M.fromList $ reverse $ zip (reverse [i .. i + 31]) (reverse (u256ToU8s v) ++ repeat 0)) 21 | 22 | mstore8 :: Monad m => U256 -> U8 -> VM m () 23 | mstore8 i b = mem %= M.insert i b 24 | 25 | 26 | mloads :: Monad m => U256 -> U256 -> VM m [U8] 27 | mloads loc len | len < 1 = return [] 28 | | otherwise = do 29 | m <- use mem 30 | return $ map (fromMaybe 0 . (`M.lookup` m)) $ [loc .. loc + len - 1] 31 | 32 | 33 | mstores :: Monad m => U256 -> U256 -> U256 -> [U8] -> VM m () 34 | mstores memloc off len v 35 | | len < 1 = return () 36 | | off +^ len > fromIntegral (length v) = return () 37 | | otherwise = mem %= M.union (M.fromList $ zip [memloc .. memloc + len - 1] (drop (fromIntegral off) v)) 38 | 39 | 40 | 41 | infixl 6 +^ 42 | 43 | (+^) :: (Integral a, Bounded a) => a -> a -> a 44 | (+^) = overflowOp (+) 45 | 46 | overflowOp :: forall a . (Integral a, Bounded a) => (Integer -> Integer -> Integer) -> a -> a -> a 47 | overflowOp f a b = if r > fromIntegral (maxBound :: a) then maxBound else fromIntegral r 48 | where r = f (fromIntegral a) (fromIntegral b) 49 | 50 | 51 | msize :: Monad m => VM m U256 52 | msize = (* 32) . ceiling . (/ (32 :: Float)) . fromIntegral . succ . maximum' . M.keys <$> use mem 53 | where maximum' [] = 0 54 | maximum' vs = maximum vs 55 | 56 | 57 | 58 | 59 | sload :: MonadExt m => U256 -> VM m U256 60 | sload i = do 61 | s <- view address 62 | fromMaybe 0 <$> extLoad s i 63 | 64 | sstore :: MonadExt m => U256 -> U256 -> VM m () 65 | sstore a b = do 66 | s <- view address 67 | extStore s a b 68 | -------------------------------------------------------------------------------- /src/Masala/VM/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE TupleSections #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE ConstraintKinds #-} 8 | {-# LANGUAGE TemplateHaskell #-} 9 | {-# LANGUAGE FlexibleInstances #-} 10 | {-# LANGUAGE MultiParamTypeClasses #-} 11 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 12 | 13 | -- | VM types. 14 | module Masala.VM.Types where 15 | 16 | import Control.Lens 17 | import Masala.Word 18 | import Masala.Instruction 19 | import qualified Data.Map.Strict as M 20 | import qualified Data.Vector as V 21 | import Control.Monad.Reader 22 | import Control.Monad.State.Strict 23 | import Control.Monad.Except 24 | 25 | -- | Bytecode program for VM use. 26 | data Prog = Prog { 27 | -- | parsed bytecode 28 | pCode :: V.Vector ByteCode 29 | -- | map of valid codepoints to vector indices 30 | , pCodeMap :: M.Map U256 Int 31 | } deriving (Eq, Show) 32 | 33 | -- | Gas as unbounded integer (actually hit tests with gas > U256) 34 | type Gas = Integer 35 | 36 | 37 | type Stack = [U256] 38 | type Mem = M.Map U256 U8 39 | type Ctr = Int 40 | data VMState = VMState { 41 | _stack :: Stack 42 | , _ctr :: Ctr 43 | , _mem :: Mem 44 | , _gas :: Gas 45 | } deriving (Eq,Show) 46 | 47 | 48 | data CallAction = SaveMem U256 U256 | SaveCode Address deriving (Eq,Show) 49 | 50 | 51 | data Resume = Resume { 52 | rPush :: U256, 53 | rResult ::[U8], 54 | rAction :: CallAction 55 | } deriving (Eq,Show) 56 | 57 | -- | Current gas models are either a fixed limit or the Ethereum model. 58 | data GasModel = 59 | FixedGasModel Gas | 60 | EthGasModel 61 | deriving (Eq,Show) 62 | 63 | 64 | -- | Reader environment maps to the yellow paper fairly closely. 65 | data Env = Env { 66 | _gasModel :: GasModel 67 | , _callData :: V.Vector U8 68 | , _prog :: Prog 69 | , _address :: Address 70 | , _origin :: Address 71 | , _caller :: Address 72 | , _envGas :: U256 73 | , _gasPrice :: U256 74 | , _callValue :: U256 75 | , _prevHash :: U256 76 | , _coinbase :: U256 77 | , _timestamp :: U256 78 | , _number :: U256 79 | , _difficulty :: U256 80 | , _gaslimit :: Gas 81 | } deriving (Eq,Show) 82 | 83 | 84 | 85 | data VMResult = 86 | Final { fReturn :: [U8] } | 87 | Call { 88 | cGas :: Gas, 89 | cAcct :: ExtAccount, 90 | cCode :: [U8], 91 | cGasLimit :: Gas, 92 | cData :: [U8], 93 | cAction :: CallAction } 94 | deriving (Eq,Show) 95 | 96 | 97 | -- | VM monad. 98 | newtype VM m a = VM { unVM :: ExceptT String (ReaderT Env (StateT VMState m)) a } 99 | deriving (Functor,Applicative,Monad,MonadError String,MonadReader Env,MonadState VMState) 100 | 101 | 102 | -- | Backend typeclass. 103 | class (Monad m) => MonadExt m where 104 | extStore :: Address -> U256 -> U256 -> m () 105 | extLoad :: Address -> U256 -> m (Maybe U256) 106 | extOut :: String -> m () 107 | extDebug :: String -> m () 108 | extAddress :: Address -> m (Maybe ExtAccount) 109 | extCreate :: Gas -> m ExtAccount 110 | extSaveCode :: Address -> [U8] -> m () 111 | extSuicide :: Address -> m Bool 112 | extRefund :: Address -> Gas -> m () 113 | extIsCreate :: Address -> m Bool 114 | extLog :: LogEntry -> m () 115 | 116 | 117 | 118 | 119 | 120 | instance MonadTrans VM where 121 | lift g = VM $ ExceptT $ ReaderT $ \_ -> StateT $ \s -> fmap (\v -> (Right v,s)) $ g 122 | 123 | {-# INLINE runVM #-} 124 | runVM :: (Monad m) => VMState -> Env -> VM m a -> m (Either String a, VMState) 125 | runVM vm env go = runStateT (runReaderT (runExceptT (unVM go)) env) vm 126 | 127 | data ControlFlow = 128 | Next 129 | | Stop 130 | | Jump Int 131 | | Return [U8] 132 | | Yield VMResult 133 | deriving (Show) 134 | 135 | emptyVMEnv :: Env 136 | emptyVMEnv = Env (FixedGasModel 1) mempty (Prog mempty mempty) 0 0 0 0 0 0 0 0 0 0 0 0 137 | emptyVMState :: VMState 138 | emptyVMState = VMState mempty 0 mempty 0 139 | 140 | 141 | data ExtAccount = ExtAccount { 142 | _acctCode :: [U8] 143 | , _acctBalance :: Gas 144 | , _acctAddress :: Address 145 | , _acctStore :: M.Map U256 U256 146 | } deriving (Eq) 147 | 148 | 149 | instance Show ExtAccount where 150 | show (ExtAccount c b a s) = 151 | "ExtAccount {code=" ++ sc c ++ ", bal=" ++ show b ++ ", addy=" ++ 152 | show a ++ ", store=" ++ show s 153 | where sc [] = "[empty]" 154 | sc _ = "*bytecode*" 155 | 156 | 157 | toAddress :: Integral i => i -> Address 158 | toAddress u = fromIntegral (u `mod` (2 ^ (160 :: Int))) 159 | 160 | 161 | data LogEntry = LogEntry { 162 | logAddress :: Address 163 | , logBlock :: U256 164 | , logTopics :: [U256] 165 | , logData :: [U8] 166 | } deriving (Eq,Show) 167 | 168 | 169 | $(makeLenses ''VMState) 170 | $(makeLenses ''Env) 171 | $(makeLenses ''ExtAccount) 172 | 173 | 174 | instance (MonadExt m) => MonadExt (VM m) where 175 | {-# INLINE extStore #-} 176 | {-# INLINE extLoad #-} 177 | {-# INLINE extOut #-} 178 | {-# INLINE extDebug #-} 179 | {-# INLINE extAddress #-} 180 | {-# INLINE extCreate #-} 181 | {-# INLINE extSaveCode #-} 182 | {-# INLINE extSuicide #-} 183 | {-# INLINE extRefund #-} 184 | {-# INLINE extIsCreate #-} 185 | {-# INLINE extLog #-} 186 | extStore a b c = lift $ extStore a b c 187 | extLoad a b = lift $ extLoad a b 188 | extOut a = lift $ extOut a 189 | extDebug a = lift $ extDebug a 190 | extAddress a = lift $ extAddress a 191 | extCreate a = lift $ extCreate a 192 | extSaveCode a b = lift $ extSaveCode a b 193 | extSuicide a = lift $ extSuicide a 194 | extRefund a b = lift $ extRefund a b 195 | extIsCreate a = lift $ extIsCreate a 196 | extLog a = lift $ extLog a 197 | 198 | instance MonadExt m => MonadExt (ExceptT a m) where 199 | {-# INLINE extStore #-} 200 | {-# INLINE extLoad #-} 201 | {-# INLINE extOut #-} 202 | {-# INLINE extDebug #-} 203 | {-# INLINE extAddress #-} 204 | {-# INLINE extCreate #-} 205 | {-# INLINE extSaveCode #-} 206 | {-# INLINE extSuicide #-} 207 | {-# INLINE extRefund #-} 208 | {-# INLINE extIsCreate #-} 209 | {-# INLINE extLog #-} 210 | extStore a b c = lift $ extStore a b c 211 | extLoad a b = lift $ extLoad a b 212 | extOut a = lift $ extOut a 213 | extDebug a = lift $ extDebug a 214 | extAddress a = lift $ extAddress a 215 | extCreate a = lift $ extCreate a 216 | extSaveCode a b = lift $ extSaveCode a b 217 | extSuicide a = lift $ extSuicide a 218 | extRefund a b = lift $ extRefund a b 219 | extIsCreate a = lift $ extIsCreate a 220 | extLog a = lift $ extLog a 221 | 222 | instance MonadExt m => MonadExt (StateT a m) where 223 | {-# INLINE extStore #-} 224 | {-# INLINE extLoad #-} 225 | {-# INLINE extOut #-} 226 | {-# INLINE extDebug #-} 227 | {-# INLINE extAddress #-} 228 | {-# INLINE extCreate #-} 229 | {-# INLINE extSaveCode #-} 230 | {-# INLINE extSuicide #-} 231 | {-# INLINE extRefund #-} 232 | {-# INLINE extIsCreate #-} 233 | {-# INLINE extLog #-} 234 | extStore a b c = lift $ extStore a b c 235 | extLoad a b = lift $ extLoad a b 236 | extOut a = lift $ extOut a 237 | extDebug a = lift $ extDebug a 238 | extAddress a = lift $ extAddress a 239 | extCreate a = lift $ extCreate a 240 | extSaveCode a b = lift $ extSaveCode a b 241 | extSuicide a = lift $ extSuicide a 242 | extRefund a b = lift $ extRefund a b 243 | extIsCreate a = lift $ extIsCreate a 244 | extLog a = lift $ extLog a 245 | 246 | 247 | instance MonadExt m => MonadExt (ReaderT a m) where 248 | {-# INLINE extStore #-} 249 | {-# INLINE extLoad #-} 250 | {-# INLINE extOut #-} 251 | {-# INLINE extDebug #-} 252 | {-# INLINE extAddress #-} 253 | {-# INLINE extCreate #-} 254 | {-# INLINE extSaveCode #-} 255 | {-# INLINE extSuicide #-} 256 | {-# INLINE extRefund #-} 257 | {-# INLINE extIsCreate #-} 258 | {-# INLINE extLog #-} 259 | extStore a b c = lift $ extStore a b c 260 | extLoad a b = lift $ extLoad a b 261 | extOut a = lift $ extOut a 262 | extDebug a = lift $ extDebug a 263 | extAddress a = lift $ extAddress a 264 | extCreate a = lift $ extCreate a 265 | extSaveCode a b = lift $ extSaveCode a b 266 | extSuicide a = lift $ extSuicide a 267 | extRefund a b = lift $ extRefund a b 268 | extIsCreate a = lift $ extIsCreate a 269 | extLog a = lift $ extLog a 270 | -------------------------------------------------------------------------------- /src/Masala/Word.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | -- | The core datatypes ('U256', 'S256', 'Word8', 'Address') and hex parsing. 8 | module Masala.Word 9 | ( 10 | U256 (..) 11 | ,S256 (..) 12 | ,U8 (..) 13 | ,Address (..) 14 | ,module Data.Bits 15 | ,showHex,showHexPad,showHexs,showBinary 16 | ,readHex,readHexs,hexSize 17 | ,u256ToU8s,u8sToU256s 18 | ,parseJSONHex 19 | ) where 20 | 21 | import Data.Word 22 | import Data.DoubleWord 23 | import Data.Aeson 24 | import Data.Aeson.Types (Parser) 25 | import GHC.Generics 26 | import Data.Bits 27 | import qualified Numeric as N 28 | import qualified Data.Text as T 29 | import Data.Char (intToDigit) 30 | import Data.List.Split 31 | 32 | 33 | -- | Main type, unsigned 256-bit word. 34 | newtype U256 = U256 Word256 deriving (Num,Eq,Ord,Bounded,Enum,Integral,Real,Generic,Bits,Read,FiniteBits) 35 | instance Show U256 where show (U256 u) = showHex u 36 | instance FromJSON U256 where 37 | parseJSON = parseJSONHex "U256" 38 | 39 | 40 | -- | Signed equivalent of 'U256'. Internal to VM only (no JSON support). 41 | newtype S256 = S256 Int256 deriving (Num,Eq,Show,Ord,Bounded,Enum,Integral,Real,Generic,Bits) 42 | 43 | -- | Newtype over Word8 to get hex output, mainly 44 | newtype U8 = U8 Word8 deriving (Num,Eq,Ord,Bounded,Enum,Integral,Real,Generic,Bits,Read,FiniteBits) 45 | instance Show U8 where show (U8 u) = showHex u 46 | 47 | 48 | newtype Address = Address Word160 deriving (Num,Eq,Ord,Bounded,Enum,Integral,Real,Generic) 49 | instance Show Address where show (Address u) = showHex u 50 | 51 | instance FromJSON Address where parseJSON = parseJSONHex "Address" 52 | 53 | 54 | 55 | showHex :: (Integral a, Show a) => a -> String 56 | showHex a = N.showHex a "" 57 | 58 | -- | showHex with padded 0s to hex size of type. 59 | showHexPad :: (FiniteBits a, Integral a, Show a, Eq a, Num a) => a -> String 60 | showHexPad v = pad $ showHex v where 61 | pad s = take (max 0 (hexSize v - length s)) (repeat '0') ++ s 62 | 63 | hexSize :: FiniteBits b => b -> Int 64 | hexSize v = finiteBitSize v `div` 4 65 | 66 | -- | concat hex reps 67 | showHexs :: (FiniteBits a, Integral a, Show a, Eq a, Num a) => [a] -> String 68 | showHexs = concatMap showHexPad 69 | 70 | 71 | -- | Binary rep. 72 | showBinary :: (Show a, Integral a) => a -> String 73 | showBinary i = N.showIntAtBase 2 intToDigit i "" 74 | 75 | -- | JSON hexadecimal parser utility. 76 | parseJSONHex :: (Eq a,Num a) => String -> Value -> Parser a 77 | parseJSONHex name = withText name (either fail return . readHex . T.unpack) 78 | 79 | -- | read unsigned hex in Either, supporting leading "0x" 80 | readHex :: (Eq a,Num a) => String -> Either String a 81 | readHex = ph . drop0x where 82 | ph s = case N.readHex s of 83 | [(a,"")] -> Right a 84 | _ -> Left $ "Invalid hex value " ++ s 85 | drop0x ('0':'x':a) = a 86 | drop0x a = a 87 | 88 | 89 | -- | read hex values, must align with hex size 90 | readHexs :: forall a . (Num a, Eq a, FiniteBits a, Bounded a) => String -> Either String [a] 91 | readHexs s = if rm == 0 92 | then sequence $ map readHex $ chunksOf sz s 93 | else Left $ "readHexs: string must align on target size (" ++ show sz ++ "): " ++ s 94 | where sz = hexSize (minBound :: a) 95 | rm = length s `mod` sz 96 | 97 | 98 | u8sToU256s :: [U8] -> [U256] 99 | u8sToU256s = fst. foldr acc ([0],0) 100 | where acc v (t:ts,p) | p < 256 = (t + shift (fromIntegral v) p:ts, p + 8) 101 | | otherwise = acc v (0:t:ts,0) 102 | acc _ ([],_) = error "c'est impossible" 103 | 104 | 105 | u256ToU8s :: U256 -> [U8] 106 | u256ToU8s 0 = [0] 107 | u256ToU8s u = w8 [] u 108 | where w8 ws v | v > 0 = w8 (fromIntegral (v .&. 0xff):ws) (v `shiftR` 8) 109 | | otherwise = ws 110 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-8.5 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | - location: 10 | git: https://github.com/sirlensalot/snap-cors.git 11 | commit: cc88bab1fd3f62dc4d9f9ad81a231877a639c812 12 | extra-dep: true 13 | 14 | allow-newer: true 15 | 16 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 17 | extra-deps: 18 | - data-dword-0.3.1.2 19 | - data-bword-0.1.0.1 20 | 21 | # Override default flag values for local packages and extra-deps 22 | flags: {} 23 | 24 | # Extra package databases containing global packages 25 | extra-package-dbs: [] 26 | 27 | # Control whether we use the GHC we find on the path 28 | # system-ghc: true 29 | 30 | # Require a specific version of stack, using version ranges 31 | # require-stack-version: -any # Default 32 | # require-stack-version: >= 1.0.0 33 | 34 | # Override the architecture used by stack, especially useful on Windows 35 | # arch: i386 36 | # arch: x86_64 37 | 38 | # Extra directories used by stack for building 39 | # extra-include-dirs: [/path/to/dir] 40 | # extra-lib-dirs: [/path/to/dir] 41 | -------------------------------------------------------------------------------- /testfiles/vmSha3Test.json: -------------------------------------------------------------------------------- 1 | { 2 | "sha3_0" : { 3 | "callcreates" : [ 4 | ], 5 | "env" : { 6 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 7 | "currentDifficulty" : "0x0100", 8 | "currentGasLimit" : "0x0f4240", 9 | "currentNumber" : "0x00", 10 | "currentTimestamp" : "0x01", 11 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 12 | }, 13 | "exec" : { 14 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 15 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 16 | "code" : "0x6000600020600055", 17 | "data" : "0x", 18 | "gas" : "0x174876e800", 19 | "gasPrice" : "0x3b9aca00", 20 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 21 | "value" : "0x0de0b6b3a7640000" 22 | }, 23 | "gas" : "0x17487699b9", 24 | "logs" : [ 25 | ], 26 | "out" : "0x", 27 | "post" : { 28 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 29 | "balance" : "0x152d02c7e14af6800000", 30 | "code" : "0x6000600020600055", 31 | "nonce" : "0x00", 32 | "storage" : { 33 | "0x00" : "0xc5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470" 34 | } 35 | } 36 | }, 37 | "pre" : { 38 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 39 | "balance" : "0x152d02c7e14af6800000", 40 | "code" : "0x6000600020600055", 41 | "nonce" : "0x00", 42 | "storage" : { 43 | } 44 | } 45 | } 46 | }, 47 | "sha3_1" : { 48 | "callcreates" : [ 49 | ], 50 | "env" : { 51 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 52 | "currentDifficulty" : "0x0100", 53 | "currentGasLimit" : "0x0f4240", 54 | "currentNumber" : "0x00", 55 | "currentTimestamp" : "0x01", 56 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 57 | }, 58 | "exec" : { 59 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 60 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 61 | "code" : "0x6005600420600055", 62 | "data" : "0x", 63 | "gas" : "0x0186a0", 64 | "gasPrice" : "0x5af3107a4000", 65 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 66 | "value" : "0x0de0b6b3a7640000" 67 | }, 68 | "gas" : "0x013850", 69 | "logs" : [ 70 | ], 71 | "out" : "0x", 72 | "post" : { 73 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 74 | "balance" : "0x152d02c7e14af6800000", 75 | "code" : "0x6005600420600055", 76 | "nonce" : "0x00", 77 | "storage" : { 78 | "0x00" : "0xc41589e7559804ea4a2080dad19d876a024ccb05117835447d72ce08c1d020ec" 79 | } 80 | } 81 | }, 82 | "pre" : { 83 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 84 | "balance" : "0x152d02c7e14af6800000", 85 | "code" : "0x6005600420600055", 86 | "nonce" : "0x00", 87 | "storage" : { 88 | } 89 | } 90 | } 91 | }, 92 | "sha3_2" : { 93 | "callcreates" : [ 94 | ], 95 | "env" : { 96 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 97 | "currentDifficulty" : "0x0100", 98 | "currentGasLimit" : "0x0f4240", 99 | "currentNumber" : "0x00", 100 | "currentTimestamp" : "0x01", 101 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 102 | }, 103 | "exec" : { 104 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 105 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 106 | "code" : "0x600a600a20600055", 107 | "data" : "0x", 108 | "gas" : "0x0186a0", 109 | "gasPrice" : "0x5af3107a4000", 110 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 111 | "value" : "0x0de0b6b3a7640000" 112 | }, 113 | "gas" : "0x013850", 114 | "logs" : [ 115 | ], 116 | "out" : "0x", 117 | "post" : { 118 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 119 | "balance" : "0x152d02c7e14af6800000", 120 | "code" : "0x600a600a20600055", 121 | "nonce" : "0x00", 122 | "storage" : { 123 | "0x00" : "0x6bd2dd6bd408cbee33429358bf24fdc64612fbf8b1b4db604518f40ffd34b607" 124 | } 125 | } 126 | }, 127 | "pre" : { 128 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 129 | "balance" : "0x152d02c7e14af6800000", 130 | "code" : "0x600a600a20600055", 131 | "nonce" : "0x00", 132 | "storage" : { 133 | } 134 | } 135 | } 136 | }, 137 | "sha3_3" : { 138 | "env" : { 139 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 140 | "currentDifficulty" : "0x0100", 141 | "currentGasLimit" : "0x0f4240", 142 | "currentNumber" : "0x00", 143 | "currentTimestamp" : "0x01", 144 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 145 | }, 146 | "exec" : { 147 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 148 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 149 | "code" : "0x620fffff6103e820600055", 150 | "data" : "0x", 151 | "gas" : "0x0186a0", 152 | "gasPrice" : "0x5af3107a4000", 153 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 154 | "value" : "0x0de0b6b3a7640000" 155 | }, 156 | "pre" : { 157 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 158 | "balance" : "0x152d02c7e14af6800000", 159 | "code" : "0x620fffff6103e820600055", 160 | "nonce" : "0x00", 161 | "storage" : { 162 | } 163 | } 164 | } 165 | }, 166 | "sha3_4" : { 167 | "env" : { 168 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 169 | "currentDifficulty" : "0x0100", 170 | "currentGasLimit" : "0x0f4240", 171 | "currentNumber" : "0x00", 172 | "currentTimestamp" : "0x01", 173 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 174 | }, 175 | "exec" : { 176 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 177 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 178 | "code" : "0x6064640fffffffff20600055", 179 | "data" : "0x", 180 | "gas" : "0x0186a0", 181 | "gasPrice" : "0x5af3107a4000", 182 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 183 | "value" : "0x0de0b6b3a7640000" 184 | }, 185 | "pre" : { 186 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 187 | "balance" : "0x152d02c7e14af6800000", 188 | "code" : "0x6064640fffffffff20600055", 189 | "nonce" : "0x00", 190 | "storage" : { 191 | } 192 | } 193 | } 194 | }, 195 | "sha3_5" : { 196 | "env" : { 197 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 198 | "currentDifficulty" : "0x0100", 199 | "currentGasLimit" : "0x0f4240", 200 | "currentNumber" : "0x00", 201 | "currentTimestamp" : "0x01", 202 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 203 | }, 204 | "exec" : { 205 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 206 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 207 | "code" : "0x640fffffffff61271020600055", 208 | "data" : "0x", 209 | "gas" : "0x0186a0", 210 | "gasPrice" : "0x5af3107a4000", 211 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 212 | "value" : "0x0de0b6b3a7640000" 213 | }, 214 | "pre" : { 215 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 216 | "balance" : "0x152d02c7e14af6800000", 217 | "code" : "0x640fffffffff61271020600055", 218 | "nonce" : "0x00", 219 | "storage" : { 220 | } 221 | } 222 | } 223 | }, 224 | "sha3_6" : { 225 | "env" : { 226 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 227 | "currentDifficulty" : "0x0100", 228 | "currentGasLimit" : "0x0f4240", 229 | "currentNumber" : "0x00", 230 | "currentTimestamp" : "0x01", 231 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 232 | }, 233 | "exec" : { 234 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 235 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 236 | "code" : "0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff20600055", 237 | "data" : "0x", 238 | "gas" : "0x0186a0", 239 | "gasPrice" : "0x5af3107a4000", 240 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 241 | "value" : "0x0de0b6b3a7640000" 242 | }, 243 | "pre" : { 244 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 245 | "balance" : "0x152d02c7e14af6800000", 246 | "code" : "0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff20600055", 247 | "nonce" : "0x00", 248 | "storage" : { 249 | } 250 | } 251 | } 252 | }, 253 | "sha3_bigOffset" : { 254 | "env" : { 255 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 256 | "currentDifficulty" : "0x0100", 257 | "currentGasLimit" : "0x0f4240", 258 | "currentNumber" : "0x00", 259 | "currentTimestamp" : "0x01", 260 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 261 | }, 262 | "exec" : { 263 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 264 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 265 | "code" : "0x60027e0fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff20600055", 266 | "data" : "0x", 267 | "gas" : "0x010000000000", 268 | "gasPrice" : "0x01", 269 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 270 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 271 | }, 272 | "pre" : { 273 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 274 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 275 | "code" : "0x60027e0fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff20600055", 276 | "nonce" : "0x00", 277 | "storage" : { 278 | } 279 | } 280 | } 281 | }, 282 | "sha3_bigOffset2" : { 283 | "callcreates" : [ 284 | ], 285 | "env" : { 286 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 287 | "currentDifficulty" : "0x0100", 288 | "currentGasLimit" : "0x0f4240", 289 | "currentNumber" : "0x00", 290 | "currentTimestamp" : "0x01", 291 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 292 | }, 293 | "exec" : { 294 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 295 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 296 | "code" : "0x6002630100000020600055", 297 | "data" : "0x", 298 | "gas" : "0x0100000000", 299 | "gasPrice" : "0x01", 300 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 301 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 302 | }, 303 | "gas" : "0xdfe7a9b0", 304 | "logs" : [ 305 | ], 306 | "out" : "0x", 307 | "post" : { 308 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 309 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 310 | "code" : "0x6002630100000020600055", 311 | "nonce" : "0x00", 312 | "storage" : { 313 | "0x00" : "0x54a8c0ab653c15bfb48b47fd011ba2b9617af01cb45cab344acd57c924d56798" 314 | } 315 | } 316 | }, 317 | "pre" : { 318 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 319 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 320 | "code" : "0x6002630100000020600055", 321 | "nonce" : "0x00", 322 | "storage" : { 323 | } 324 | } 325 | } 326 | }, 327 | "sha3_bigSize" : { 328 | "env" : { 329 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 330 | "currentDifficulty" : "0x0100", 331 | "currentGasLimit" : "0x0f4240", 332 | "currentNumber" : "0x00", 333 | "currentTimestamp" : "0x01", 334 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 335 | }, 336 | "exec" : { 337 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 338 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 339 | "code" : "0x7effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff20600055", 340 | "data" : "0x", 341 | "gas" : "0x010000000000", 342 | "gasPrice" : "0x01", 343 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 344 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 345 | }, 346 | "pre" : { 347 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 348 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 349 | "code" : "0x7effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7effffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff20600055", 350 | "nonce" : "0x00", 351 | "storage" : { 352 | } 353 | } 354 | } 355 | }, 356 | "sha3_memSizeNoQuadraticCost31" : { 357 | "callcreates" : [ 358 | ], 359 | "env" : { 360 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 361 | "currentDifficulty" : "0x0100", 362 | "currentGasLimit" : "0x0f4240", 363 | "currentNumber" : "0x00", 364 | "currentTimestamp" : "0x01", 365 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 366 | }, 367 | "exec" : { 368 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 369 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 370 | "code" : "0x60016103c020600055", 371 | "data" : "0x", 372 | "gas" : "0x0100000000", 373 | "gasPrice" : "0x01", 374 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 375 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 376 | }, 377 | "gas" : "0xffffb155", 378 | "logs" : [ 379 | ], 380 | "out" : "0x", 381 | "post" : { 382 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 383 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 384 | "code" : "0x60016103c020600055", 385 | "nonce" : "0x00", 386 | "storage" : { 387 | "0x00" : "0xbc36789e7a1e281436464229828f817d6612f7b477d66591ff96a9e064bcc98a" 388 | } 389 | } 390 | }, 391 | "pre" : { 392 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 393 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 394 | "code" : "0x60016103c020600055", 395 | "nonce" : "0x00", 396 | "storage" : { 397 | } 398 | } 399 | } 400 | }, 401 | "sha3_memSizeQuadraticCost32" : { 402 | "callcreates" : [ 403 | ], 404 | "env" : { 405 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 406 | "currentDifficulty" : "0x0100", 407 | "currentGasLimit" : "0x0f4240", 408 | "currentNumber" : "0x00", 409 | "currentTimestamp" : "0x01", 410 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 411 | }, 412 | "exec" : { 413 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 414 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 415 | "code" : "0x60016103e020600055", 416 | "data" : "0x", 417 | "gas" : "0x0100000000", 418 | "gasPrice" : "0x01", 419 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 420 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 421 | }, 422 | "gas" : "0xffffb151", 423 | "logs" : [ 424 | ], 425 | "out" : "0x", 426 | "post" : { 427 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 428 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 429 | "code" : "0x60016103e020600055", 430 | "nonce" : "0x00", 431 | "storage" : { 432 | "0x00" : "0xbc36789e7a1e281436464229828f817d6612f7b477d66591ff96a9e064bcc98a" 433 | } 434 | } 435 | }, 436 | "pre" : { 437 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 438 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 439 | "code" : "0x60016103e020600055", 440 | "nonce" : "0x00", 441 | "storage" : { 442 | } 443 | } 444 | } 445 | }, 446 | "sha3_memSizeQuadraticCost32_zeroSize" : { 447 | "callcreates" : [ 448 | ], 449 | "env" : { 450 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 451 | "currentDifficulty" : "0x0100", 452 | "currentGasLimit" : "0x0f4240", 453 | "currentNumber" : "0x00", 454 | "currentTimestamp" : "0x01", 455 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 456 | }, 457 | "exec" : { 458 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 459 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 460 | "code" : "0x600061040020600055", 461 | "data" : "0x", 462 | "gas" : "0x0100000000", 463 | "gasPrice" : "0x01", 464 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 465 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 466 | }, 467 | "gas" : "0xffffb1b9", 468 | "logs" : [ 469 | ], 470 | "out" : "0x", 471 | "post" : { 472 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 473 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 474 | "code" : "0x600061040020600055", 475 | "nonce" : "0x00", 476 | "storage" : { 477 | "0x00" : "0xc5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470" 478 | } 479 | } 480 | }, 481 | "pre" : { 482 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 483 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 484 | "code" : "0x600061040020600055", 485 | "nonce" : "0x00", 486 | "storage" : { 487 | } 488 | } 489 | } 490 | }, 491 | "sha3_memSizeQuadraticCost33" : { 492 | "callcreates" : [ 493 | ], 494 | "env" : { 495 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 496 | "currentDifficulty" : "0x0100", 497 | "currentGasLimit" : "0x0f4240", 498 | "currentNumber" : "0x00", 499 | "currentTimestamp" : "0x01", 500 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 501 | }, 502 | "exec" : { 503 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 504 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 505 | "code" : "0x600161040020600055", 506 | "data" : "0x", 507 | "gas" : "0x0100000000", 508 | "gasPrice" : "0x01", 509 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 510 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 511 | }, 512 | "gas" : "0xffffb14e", 513 | "logs" : [ 514 | ], 515 | "out" : "0x", 516 | "post" : { 517 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 518 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 519 | "code" : "0x600161040020600055", 520 | "nonce" : "0x00", 521 | "storage" : { 522 | "0x00" : "0xbc36789e7a1e281436464229828f817d6612f7b477d66591ff96a9e064bcc98a" 523 | } 524 | } 525 | }, 526 | "pre" : { 527 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 528 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 529 | "code" : "0x600161040020600055", 530 | "nonce" : "0x00", 531 | "storage" : { 532 | } 533 | } 534 | } 535 | }, 536 | "sha3_memSizeQuadraticCost63" : { 537 | "callcreates" : [ 538 | ], 539 | "env" : { 540 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 541 | "currentDifficulty" : "0x0100", 542 | "currentGasLimit" : "0x0f4240", 543 | "currentNumber" : "0x00", 544 | "currentTimestamp" : "0x01", 545 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 546 | }, 547 | "exec" : { 548 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 549 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 550 | "code" : "0x60016107c020600055", 551 | "data" : "0x", 552 | "gas" : "0x0100000000", 553 | "gasPrice" : "0x01", 554 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 555 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 556 | }, 557 | "gas" : "0xffffb0ef", 558 | "logs" : [ 559 | ], 560 | "out" : "0x", 561 | "post" : { 562 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 563 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 564 | "code" : "0x60016107c020600055", 565 | "nonce" : "0x00", 566 | "storage" : { 567 | "0x00" : "0xbc36789e7a1e281436464229828f817d6612f7b477d66591ff96a9e064bcc98a" 568 | } 569 | } 570 | }, 571 | "pre" : { 572 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 573 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 574 | "code" : "0x60016107c020600055", 575 | "nonce" : "0x00", 576 | "storage" : { 577 | } 578 | } 579 | } 580 | }, 581 | "sha3_memSizeQuadraticCost64" : { 582 | "callcreates" : [ 583 | ], 584 | "env" : { 585 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 586 | "currentDifficulty" : "0x0100", 587 | "currentGasLimit" : "0x0f4240", 588 | "currentNumber" : "0x00", 589 | "currentTimestamp" : "0x01", 590 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 591 | }, 592 | "exec" : { 593 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 594 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 595 | "code" : "0x60016107e020600055", 596 | "data" : "0x", 597 | "gas" : "0x0100000000", 598 | "gasPrice" : "0x01", 599 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 600 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 601 | }, 602 | "gas" : "0xffffb0eb", 603 | "logs" : [ 604 | ], 605 | "out" : "0x", 606 | "post" : { 607 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 608 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 609 | "code" : "0x60016107e020600055", 610 | "nonce" : "0x00", 611 | "storage" : { 612 | "0x00" : "0xbc36789e7a1e281436464229828f817d6612f7b477d66591ff96a9e064bcc98a" 613 | } 614 | } 615 | }, 616 | "pre" : { 617 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 618 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 619 | "code" : "0x60016107e020600055", 620 | "nonce" : "0x00", 621 | "storage" : { 622 | } 623 | } 624 | } 625 | }, 626 | "sha3_memSizeQuadraticCost64_2" : { 627 | "callcreates" : [ 628 | ], 629 | "env" : { 630 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 631 | "currentDifficulty" : "0x0100", 632 | "currentGasLimit" : "0x0f4240", 633 | "currentNumber" : "0x00", 634 | "currentTimestamp" : "0x01", 635 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 636 | }, 637 | "exec" : { 638 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 639 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 640 | "code" : "0x60206107e020600055", 641 | "data" : "0x", 642 | "gas" : "0x0100000000", 643 | "gasPrice" : "0x01", 644 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 645 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 646 | }, 647 | "gas" : "0xffffb0eb", 648 | "logs" : [ 649 | ], 650 | "out" : "0x", 651 | "post" : { 652 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 653 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 654 | "code" : "0x60206107e020600055", 655 | "nonce" : "0x00", 656 | "storage" : { 657 | "0x00" : "0x290decd9548b62a8d60345a988386fc84ba6bc95484008f6362f93160ef3e563" 658 | } 659 | } 660 | }, 661 | "pre" : { 662 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 663 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 664 | "code" : "0x60206107e020600055", 665 | "nonce" : "0x00", 666 | "storage" : { 667 | } 668 | } 669 | } 670 | }, 671 | "sha3_memSizeQuadraticCost65" : { 672 | "callcreates" : [ 673 | ], 674 | "env" : { 675 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 676 | "currentDifficulty" : "0x0100", 677 | "currentGasLimit" : "0x0f4240", 678 | "currentNumber" : "0x00", 679 | "currentTimestamp" : "0x01", 680 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 681 | }, 682 | "exec" : { 683 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 684 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 685 | "code" : "0x600161080020600055", 686 | "data" : "0x", 687 | "gas" : "0x0100000000", 688 | "gasPrice" : "0x01", 689 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 690 | "value" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" 691 | }, 692 | "gas" : "0xffffb0e8", 693 | "logs" : [ 694 | ], 695 | "out" : "0x", 696 | "post" : { 697 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 698 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 699 | "code" : "0x600161080020600055", 700 | "nonce" : "0x00", 701 | "storage" : { 702 | "0x00" : "0xbc36789e7a1e281436464229828f817d6612f7b477d66591ff96a9e064bcc98a" 703 | } 704 | } 705 | }, 706 | "pre" : { 707 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 708 | "balance" : "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff", 709 | "code" : "0x600161080020600055", 710 | "nonce" : "0x00", 711 | "storage" : { 712 | } 713 | } 714 | } 715 | } 716 | } -------------------------------------------------------------------------------- /testfiles/vmtests.json: -------------------------------------------------------------------------------- 1 | { 2 | "arith" : { 3 | "env" : { 4 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 5 | "currentDifficulty" : "0x0100", 6 | "currentGasLimit" : "0x0f4240", 7 | "currentNumber" : "0x00", 8 | "currentTimestamp" : "0x01", 9 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 10 | }, 11 | "exec" : { 12 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 13 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 14 | "code" : "0x600060006000600060026002600803036002600306600260020460046004600402026002600201010101013360c85a03f1", 15 | "data" : "0x", 16 | "gas" : "0x0186a0", 17 | "gasPrice" : "0x5af3107a4000", 18 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 19 | "value" : "0x0de0b6b3a7640000" 20 | }, 21 | "pre" : { 22 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 23 | "balance" : "0x152d02c7e14af6800000", 24 | "code" : "0x600060006000600060026002600803036002600306600260020460046004600402026002600201010101013360c85a03f1", 25 | "nonce" : "0x00", 26 | "storage" : { 27 | } 28 | } 29 | } 30 | }, 31 | "boolean" : { 32 | "env" : { 33 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 34 | "currentDifficulty" : "0x0100", 35 | "currentGasLimit" : "0x0f4240", 36 | "currentNumber" : "0x00", 37 | "currentTimestamp" : "0x01", 38 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 39 | }, 40 | "exec" : { 41 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 42 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 43 | "code" : "0x600160011615601a57600060006000600060023360c85a03f1505b600060011615603557600060006000600060033360c85a03f1505b600160001615605057600060006000600060043360c85a03f1505b600060001615606b57600060006000600060053360c85a03f1505b6001600117156086576000600060006000600c3360c85a03f1505b60006001171560a1576000600060006000600d3360c85a03f1505b60016000171560bc576000600060006000600e3360c85a03f1505b60006000171560d7576000600060006000600f3360c85a03f1505b", 44 | "data" : "0x", 45 | "gas" : "0x0186a0", 46 | "gasPrice" : "0x5af3107a4000", 47 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 48 | "value" : "0x0de0b6b3a7640000" 49 | }, 50 | "pre" : { 51 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 52 | "balance" : "0x152d02c7e14af6800000", 53 | "code" : "0x600160011615601a57600060006000600060023360c85a03f1505b600060011615603557600060006000600060033360c85a03f1505b600160001615605057600060006000600060043360c85a03f1505b600060001615606b57600060006000600060053360c85a03f1505b6001600117156086576000600060006000600c3360c85a03f1505b60006001171560a1576000600060006000600d3360c85a03f1505b60016000171560bc576000600060006000600e3360c85a03f1505b60006000171560d7576000600060006000600f3360c85a03f1505b", 54 | "nonce" : "0x00", 55 | "storage" : { 56 | } 57 | } 58 | } 59 | }, 60 | "mktx" : { 61 | "env" : { 62 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 63 | "currentDifficulty" : "0x0100", 64 | "currentGasLimit" : "0x0f4240", 65 | "currentNumber" : "0x00", 66 | "currentTimestamp" : "0x01", 67 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 68 | }, 69 | "exec" : { 70 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 71 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 72 | "code" : "0x60006000600060006706f05b59d3b200003360c85a03f1", 73 | "data" : "0x", 74 | "gas" : "0x0186a0", 75 | "gasPrice" : "0x5af3107a4000", 76 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 77 | "value" : "0x0de0b6b3a7640000" 78 | }, 79 | "pre" : { 80 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 81 | "balance" : "0x152d02c7e14af6800000", 82 | "code" : "0x60006000600060006706f05b59d3b200003360c85a03f1", 83 | "nonce" : "0x00", 84 | "storage" : { 85 | } 86 | } 87 | } 88 | }, 89 | "suicide" : { "skip": "Not supporting absurd create-on-overflow nonsense EVEN MORE ABSURD TO CREATE ON SUICIDE", 90 | "callcreates" : [ 91 | ], 92 | "env" : { 93 | "currentCoinbase" : "2adc25665018aa1fe0e6bc666dac8fc2697ff9ba", 94 | "currentDifficulty" : "0x0100", 95 | "currentGasLimit" : "0x0f4240", 96 | "currentNumber" : "0x00", 97 | "currentTimestamp" : "0x01", 98 | "previousHash" : "5e20a0453cecd065ea59c37ac63e079ee08998b6045136a8ce6635c7912ec0b6" 99 | }, 100 | "exec" : { 101 | "address" : "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6", 102 | "caller" : "cd1722f3947def4cf144679da39c4c32bdc35681", 103 | "code" : "0x33ff", 104 | "data" : "0x", 105 | "gas" : "0x0186a0", 106 | "gasPrice" : "0x5af3107a4000", 107 | "origin" : "cd1722f3947def4cf144679da39c4c32bdc35681", 108 | "value" : "0x0de0b6b3a7640000" 109 | }, 110 | "gas" : "0x01869e", 111 | "logs" : [ 112 | ], 113 | "out" : "0x", 114 | "post" : { 115 | "cd1722f3947def4cf144679da39c4c32bdc35681" : { 116 | "balance" : "0x152d02c7e14af6800000", 117 | "code" : "0x", 118 | "nonce" : "0x00", 119 | "storage" : { 120 | } 121 | } 122 | }, 123 | "pre" : { 124 | "0f572e5295c57f15886f9b263e2f6d2d6c7b5ec6" : { 125 | "balance" : "0x152d02c7e14af6800000", 126 | "code" : "0x33ff", 127 | "nonce" : "0x00", 128 | "storage" : { 129 | } 130 | } 131 | } 132 | } 133 | } 134 | -------------------------------------------------------------------------------- /tests/JSONSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | -- | Supports the go-ethereum and cpp-ethereum json test cases, either as an HSpec or a report in IO. 6 | module JSONSpec where 7 | 8 | import qualified Data.Map.Strict as M 9 | import Masala.Word 10 | import Masala.Instruction hiding (Spec,spec) 11 | import Masala.Ext.Simple 12 | import Masala.VM 13 | import Masala.VM.Types 14 | import Masala.RPC 15 | import Data.Aeson hiding ((.=),Success) 16 | import Data.Aeson.Types hiding (parse,Success) 17 | import GHC.Generics 18 | import qualified Data.ByteString.Lazy.Char8 as LBS 19 | import qualified Data.Vector as V 20 | import Data.Maybe 21 | import Prelude hiding (words) 22 | import qualified Data.Set as S 23 | import Control.Exception 24 | import Control.Monad 25 | import Test.Hspec 26 | import System.Directory 27 | 28 | 29 | 30 | data TestResult = 31 | Success { tname :: String } 32 | | Failure { tname :: String, 33 | ttest :: VMTest, 34 | tout :: (VMResult,VMState,ExtData), 35 | terr :: String } 36 | | Err { tname :: String, terr :: String } 37 | instance Show TestResult where 38 | show (Success n) = "SUCCESS: " ++ n 39 | show (Err n e) = "ERROR: " ++ n ++ ": " ++ e 40 | show (Failure n _t _o e) = "FAILURE: " ++ n ++ ": " ++ e 41 | 42 | -- | Runs all files in "testfiles" dir. 43 | spec :: Spec 44 | spec = do 45 | tfs <- runIO (filter ((".json" ==).reverse.take 5.reverse) <$> getDirectoryContents "testfiles") 46 | mapM_ (parallel.fileSpec) tfs 47 | 48 | 49 | -- | Run a json file in HSpec. 50 | fileSpec :: FilePath -> Spec 51 | fileSpec tf = 52 | describe tf $ do 53 | vts <- runIO $ readVMTests tf 54 | forM_ (M.toList vts) $ \(n,vt) -> 55 | do 56 | tr <- runIO $ runTest False n vt 57 | let success = return () :: Expectation 58 | case tr of 59 | (Success sn) -> it sn success 60 | r -> case vskip vt of 61 | Just reason -> it (n ++ " [UNSUPPORTED, " ++ reason ++ "]: " ++ show r) success 62 | Nothing -> it n $ expectationFailure (show r) 63 | 64 | -- | run test file with optional debug out 65 | runFile :: Bool -> FilePath -> IO [TestResult] 66 | runFile d f = readVMTests f >>= mapM (uncurry (runTest d)) . M.toList 67 | 68 | 69 | -- | run one test with debug output 70 | runOne :: FilePath -> String -> IO TestResult 71 | runOne f t = do 72 | m <- readVMTests f 73 | case M.lookup t m of 74 | Nothing -> return $ Err t $ "Unknown test, file " ++ f 75 | Just tc -> do 76 | r <- runTest True t tc 77 | case r of 78 | Failure{} -> putStrLn $ "Failure, testcase: " ++ show tc 79 | _ -> return () 80 | return r 81 | 82 | 83 | 84 | -- | parse JSON 85 | readVMTests :: FilePath -> IO (M.Map String VMTest) 86 | readVMTests f = LBS.readFile ("testfiles/" ++ f) >>= either bad return . eitherDecode 87 | where bad err = throwIO $ userError $ "ERROR: decode failed: " ++ f ++ ": " ++ err 88 | 89 | -- | execute VM test 90 | runTest :: Bool -> String -> VMTest -> IO TestResult 91 | runTest dbg t tc = do 92 | when dbg $ do 93 | putStrLn "-----------------" 94 | putStrLn t 95 | putStrLn "-----------------" 96 | let catcher :: SomeException -> IO (Either String (VMResult,VMState,ExtData)) 97 | catcher e = return $ Left $ "Runtime exception: " ++ show e 98 | r <- catch (runVMTest dbg t tc) catcher 99 | case r of 100 | Left e -> if isNothing (vpost tc) && isNothing (vout tc) 101 | then return $ Success (t ++ " [with failure: " ++ e ++ "]") 102 | else return $ Err t $ "Runtime failure: " ++ e 103 | Right o -> do 104 | let tr = validateRun t tc o 105 | when dbg $ print tr 106 | return tr 107 | {- 108 | actionSuicides :: ExtData -> ExtData 109 | actionSuicides ed = over edAccts (M.filterWithKey isSuicide) ed 110 | where isSuicide a _ = not $ a `S.member` (view edSuicides ed) 111 | -} 112 | 113 | validateRun :: String -> VMTest -> (VMResult,VMState,ExtData) -> TestResult 114 | validateRun n t o@(vr,_vs,ed) = either (Failure n t o) (const (Success n)) check 115 | where check = checkPost (vpost t) >> checkOutput (vout t) 116 | checkPost Nothing = Right () 117 | checkPost (Just ts) = assertPostAcctsMatch (M.mapWithKey toEacct (testAccts ts)) (_edAccts ed) 118 | checkOutput Nothing = Right () 119 | checkOutput (Just ws) = 120 | case vr of 121 | Final os -> assertEqual "output matches" (getWords ws) os 122 | r -> Left $ "FAILED: non-final result expected " ++ show ws ++ ", result: " ++ show r 123 | 124 | assertPostAcctsMatch :: M.Map Address ExtAccount -> M.Map Address ExtAccount -> Either String () 125 | assertPostAcctsMatch i a | i == a = return () 126 | | M.keys i /= M.keys a = assertEqual "post accts match" i a 127 | | otherwise = either Left (const $ Right ()) $ 128 | mapM testEach (M.toList $ M.intersectionWith (,) i a) 129 | 130 | testEach :: (Address, (ExtAccount, ExtAccount)) -> Either String () 131 | testEach (k, (i, a)) = do 132 | let msg m = "Account '" ++ show k ++ "' " ++ m ++ " equal" 133 | assertEqual (msg "code") (_acctCode i) (_acctCode a) 134 | assertEqual (msg "balance") (_acctBalance i) (_acctBalance a) 135 | assertEqual (msg "store") (_acctStore i) (_acctStore a) 136 | 137 | assertEqual :: (Eq a, Show a) => String -> a -> a -> Either String () 138 | assertEqual msg a b | a == b = return () 139 | | otherwise = Left $ "FAILED: " ++ msg ++ ", intended=" ++ 140 | show a ++ ", actual=" ++ show b 141 | 142 | runVMTest :: Bool -> String -> VMTest -> IO (Either String (VMResult, VMState, ExtData)) 143 | runVMTest dbg testname test = do 144 | when dbg $ do 145 | putStrLn ("Test: " ++ show test) 146 | putStrLn ("Prog: " ++ show tbc) 147 | if null tbc then return $ Right (Final [],vmstate,exdata) 148 | else fixup <$> runMExt (launchVM vmstate env Nothing) exdata 149 | where vmstate = emptyState gas' 150 | fixup ((Left err,_),_) = Left $ "Test failed: " ++ testname ++ ": " ++ err 151 | fixup ((Right r,vs),e) = Right (r,vs,e) 152 | env = Env { 153 | _gasModel = EthGasModel 154 | , _callData = V.fromList (getWords (edata ex)) 155 | , _prog = toProg tbc 156 | , _address = eaddress ex 157 | , _origin = eorigin ex 158 | , _caller = ecaller ex 159 | , _envGas = fromMaybe 0 (vgas test) 160 | , _gasPrice = egasPrice ex 161 | , _callValue = evalue ex 162 | , _prevHash = fromMaybe 0 $ previousHash tenv 163 | , _coinbase = currentCoinbase tenv 164 | , _timestamp = currentTimestamp tenv 165 | , _number = currentNumber tenv 166 | , _difficulty = currentDifficulty tenv 167 | , _gaslimit = maybe 0 fromIntegral $ currentGasLimit tenv 168 | } 169 | ex = vexec test 170 | tenv = venv test 171 | tbc = concatMap toByteCode (parse (getWords (ecode ex))) 172 | gas' = fromIntegral $ egas ex 173 | exdata = ExtData (M.mapWithKey toEacct (testAccts (vpre test))) S.empty S.empty M.empty [] dbg 174 | 175 | 176 | toEacct :: Address -> TestAcct -> ExtAccount 177 | toEacct k acct = ExtAccount { 178 | _acctCode = getWords (acode acct) 179 | , _acctBalance = fromIntegral $ abalance acct 180 | , _acctAddress = k 181 | , _acctStore = testStore $ astorage acct 182 | } 183 | 184 | newtype TestAccts = TestAccts { testAccts :: M.Map Address TestAcct } deriving (Eq,Show) 185 | 186 | data VMTest = VMTest { 187 | vexec :: TestExec 188 | , vskip :: Maybe String 189 | , vgas :: Maybe U256 190 | , vlogs :: Maybe [TestLog] 191 | , vout :: Maybe WordArray 192 | , vpost :: Maybe TestAccts 193 | , vpre :: TestAccts 194 | , vpostStateRoot :: Maybe String 195 | , venv :: TestEnv 196 | , vcallcreates :: Maybe [CallCreate] -- apparently unused in vmtests 197 | } deriving (Eq,Show,Generic) 198 | instance FromJSON VMTest where parseJSON = parseDropPfxJSON 1 199 | 200 | data CallCreate = CallCreate { 201 | ccdata :: WordArray 202 | --, ccdestination :: Maybe U256 TODO empty strings????? 203 | , ccgasLimit :: U256 204 | , ccvalue :: U256 205 | } deriving (Eq,Show,Generic) 206 | instance FromJSON CallCreate where parseJSON = parseDropPfxJSON 2 207 | 208 | data TestEnv = TestEnv { 209 | currentCoinbase :: U256 210 | , currentDifficulty :: U256 211 | , currentGasLimit :: Maybe U256 212 | , currentNumber :: U256 213 | , currentTimestamp :: U256 214 | , previousHash :: Maybe U256 215 | } deriving (Eq,Show,Generic) 216 | instance FromJSON TestEnv 217 | 218 | data TestExec = TestExec { 219 | eaddress :: Address 220 | , ecaller :: Address 221 | , ecode :: WordArray 222 | , edata :: WordArray 223 | , egas :: U256 224 | , egasPrice :: U256 225 | , eorigin :: Address 226 | , evalue :: U256 227 | } deriving (Eq,Show,Generic) 228 | instance FromJSON TestExec where parseJSON = parseDropPfxJSON 1 229 | 230 | data TestLog = TestLog { 231 | laddress :: Address 232 | , lbloom :: String 233 | , ldata :: String 234 | , topics :: [U256] 235 | } deriving (Eq,Show,Generic) 236 | instance FromJSON TestLog where parseJSON = parseDropPfxJSON 1 237 | 238 | 239 | newtype TestStore = TestStore { testStore :: M.Map U256 U256 } deriving (Eq,Show) 240 | 241 | 242 | data TestAcct = TestAcct { 243 | abalance :: U256 244 | , acode :: WordArray 245 | , anonce :: U256 246 | , astorage :: TestStore 247 | } deriving (Eq,Show,Generic) 248 | instance FromJSON TestAcct where parseJSON = parseDropPfxJSON 1 249 | 250 | instance FromJSON TestAccts where 251 | parseJSON = fmap TestAccts . parseMap (either error id . readHex) 252 | instance FromJSON TestStore where 253 | parseJSON = fmap TestStore . parseMap (either error id . readHex) 254 | 255 | parseMap :: (FromJSON (M.Map k' v), Ord k) => 256 | (k' -> k) -> Value -> Parser (M.Map k v) 257 | parseMap keyFun = fmap (hashMapKey keyFun) . parseJSON 258 | where hashMapKey kv = M.foldrWithKey (M.insert . kv) M.empty 259 | -------------------------------------------------------------------------------- /tests/MemorySpec.hs: -------------------------------------------------------------------------------- 1 | module MemorySpec where 2 | 3 | import Masala.VM.Types 4 | import Masala.VM.Memory 5 | import Test.Hspec 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "testMemory" testMemory 10 | describe "testMSize" testMSize 11 | 12 | testMemory :: Spec 13 | testMemory = do 14 | it "mstore->mload" $ (runD $ mstore 0 20 >> mload 0) `shouldOutput` 20 15 | it "mstore8->mload" $ (runD $ mstore8 31 20 >> mload 0) `shouldOutput` 20 16 | it "mload shouldn't blow up" $ (runD $ mload maxBound) `shouldOutput` 0 17 | 18 | testMSize :: Spec 19 | testMSize = do 20 | it "rounds up 32" $ (runD $ mstore 0x5a 0xeeee >> msize) `shouldOutput` 0x80 21 | 22 | shouldOutput :: (Eq a,Show a) => IO (Either String a, VMState) -> a -> Expectation 23 | shouldOutput action expected = do 24 | a <- action 25 | case a of 26 | (Left s,_) -> expectationFailure $ "Failure occured: " ++ show s 27 | (Right r,_) -> r `shouldBe` expected 28 | 29 | 30 | runD :: VM IO a -> IO (Either String a, VMState) 31 | runD act = runVM emptyVMState emptyVMEnv act 32 | -------------------------------------------------------------------------------- /tests/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------