diff --git a/.github/scripts/install-cvc4.sh b/.github/scripts/install-cvc4.sh deleted file mode 100755 index 150a727f1..000000000 --- a/.github/scripts/install-cvc4.sh +++ /dev/null @@ -1,33 +0,0 @@ -#!/bin/bash - - -set -eux - -mkdir -p $HOME/.local/bin; - -travis_retry() { - cmd=$* - $cmd || (sleep 2 && $cmd) || (sleep 10 && $cmd) -} - -fetch_cvc4_linux() { - VER="$1" - wget "https://github.com/CVC4/CVC4/releases/download/$VER/cvc4-$VER-x86_64-linux-opt" - chmod +x "cvc4-$VER-x86_64-linux-opt" - mv "cvc4-$VER-x86_64-linux-opt" "$HOME/.local/bin/cvc4" - echo "Downloaded cvc4 $VER" -} - -fetch_cvc4_macos() { - VER="$1" - wget "https://github.com/CVC4/CVC4/releases/download/$VER/cvc4-$VER-macos-opt" - chmod +x "cvc4-$VER-macos-opt" - mv "cvc4-$VER-macos-opt" "$HOME/.local/bin/cvc4" - echo "Downloaded cvc4 $VER" -} - -if [ "$HOST_OS" = "Linux" ]; then - travis_retry fetch_cvc4_linux "1.8" -else - travis_retry fetch_cvc4_macos "1.8" -fi diff --git a/.github/scripts/install-cvc5.sh b/.github/scripts/install-cvc5.sh new file mode 100755 index 000000000..16dca22e4 --- /dev/null +++ b/.github/scripts/install-cvc5.sh @@ -0,0 +1,33 @@ +#!/bin/bash + + +set -eux + +mkdir -p $HOME/.local/bin; + +travis_retry() { + cmd=$* + $cmd || (sleep 2 && $cmd) || (sleep 10 && $cmd) +} + +fetch_cvc5_linux() { + VER="$1" + wget "https://github.com/cvc5/cvc5/releases/download/$VER/cvc5-$VER-x86_64-linux-opt" + chmod +x "cvc5-$VER-x86_64-linux-opt" + mv "cvc5-$VER-x86_64-linux-opt" "$HOME/.local/bin/cvc5" + echo "Downloaded cvc5 $VER" +} + +fetch_cvc5_macos() { + VER="$1" + wget "https://github.com/cvc5/cvc5/releases/download/$VER/cvc5-$VER-macos-opt" + chmod +x "cvc5-$VER-macos-opt" + mv "cvc5-$VER-macos-opt" "$HOME/.local/bin/cvc5" + echo "Downloaded cvc5 $VER" +} + +if [ "$HOST_OS" = "Linux" ]; then + travis_retry fetch_cvc5_linux "1.8" +else + travis_retry fetch_cvc5_macos "1.8" +fi diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index f1c9b0f63..593880da7 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -22,20 +22,18 @@ jobs: fail-fast: false runs-on: ${{ matrix.os }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 # v12 - - uses: cachix/install-nix-action@v14.1 + - uses: cachix/install-nix-action@v20 with: # https://discourse.nixos.org/t/understanding-binutils-darwin-wrapper-nix-support-bad-substitution/11475/2 nix_path: nixpkgs=channel:nixos-unstable # v8 - - uses: cachix/cachix-action@v10 + - uses: cachix/cachix-action@v12 with: name: dapp signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' - name: run dapp tests - run: nix-shell --pure src/dapp-tests/shell.nix --command 'make ci --directory src/dapp-tests' - - name: run hevm symbolic tests - run: nix-build -j 1 -A hevm-tests + run: FORCE_COLOR=true nix-shell --pure src/dapp-tests/shell.nix --command 'make ci --directory src/dapp-tests' - run: nix-collect-garbage - run: nix-build release.nix -A dapphub.${{ matrix.os_attr }}.stable diff --git a/.github/workflows/flake.yml b/.github/workflows/flake.yml new file mode 100644 index 000000000..34df0b20c --- /dev/null +++ b/.github/workflows/flake.yml @@ -0,0 +1,20 @@ +name: Flake +on: + pull_request: + push: + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +jobs: + build: + strategy: + matrix: + os: [ ubuntu-latest, macos-latest ] + fail-fast: false + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v3 + - uses: cachix/install-nix-action@v20 + - run: nix build --accept-flake-config .#{dapp,ethsign,hevm,seth,solc} diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index e57165bab..b68ff6a7e 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -50,7 +50,7 @@ jobs: run: | .github/scripts/install-solc.sh .github/scripts/install-z3.sh - .github/scripts/install-cvc4.sh + .github/scripts/install-cvc5.sh env: HOST_OS: ${{ runner.os }} @@ -93,8 +93,7 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 - # v12 - - uses: cachix/install-nix-action@v14.1 + - uses: cachix/install-nix-action@v20 # v8 - uses: cachix/cachix-action@v10 with: diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md index 056d2cfd4..0732da4fc 100644 --- a/ARCHITECTURE.md +++ b/ARCHITECTURE.md @@ -15,60 +15,3 @@ The main entrypoint for any invocation of `seth` or `dapp` is a dispatch script, `./src/seth/libexec/seth/seth` and `./src/dapp/libexec/dapp/dapp` respectively, which parses any flags given, setting their values to the appropriate environment variable, and dispatches to the appropriate subcommand. - -# hevm - -The core evm semnatics in hevm can be found in `EVM.hs`. EVM state is contained in the `VM` record, -and the `exec1` function executes a single opcode inside the monad `type EVM a = State VM a`. - -The core semantics are pure, and should information from the outside world be required to continue -execution (rpc queries, smt queires, user input), execution will halt, and the `result` field of the -VM will be an instance of `VMFailure (Query _)`. - -Multiple steps of EVM execution are orchestrated via interpreters for a meta language. Programs in -the meta language are called Steppers. The instructions in the meta language can be found in -`Stepper.hs`. - -There are many different interpreters with different -features, e.g. a concrete interpreter, a symbolic interpreter, an interpreter that collects coverage -information, a debug interpreter that can accept user input. Interpreters can handle Queries in -different ways, for example in the symbolic inerpreter, both sides of a branch point will be -explored, while in the symbolic debug interpreter, user input will be requested to determine which -side of the branch point will be taken. - -Interpreters are parameterized by a `Fetcher` that can handle rpc and smt queries, and can be -instantiated with fetchers that could have different fetching strategies (e.g. caching). - -Interpreters execute Steppers and use their Fetcher to handle any Queries that need to be resolved. - -This architecure is very modular and pluggable, and allows the core semantics to be shared between -different interpreters, as well as the reuse of steppers between different interpreters, making it -easy to e.g. replay a failed test in the debug interpreter, or to share the same test execution -strategy between concrete and symbolic interpreters. - -```mermaid -graph LR - subgraph meta-language - A[Stepper] - end - subgraph interpreters - A --> B[Concrete] - A --> C[Symbolic] - A --> D[Coverage] - A --> E[Debug] - end - subgraph fetchers - F[Fetch.hs] - B --> F - C --> F - D --> F - E --> F - end - subgraph EVM Semantics - G[EVM.hs] - B --> G - C --> G - D --> G - E --> G - end -``` diff --git a/README.md b/README.md index c87716763..0daddeec5 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,6 @@ hand-crafted and maintained by DappHub, along with dependency management, courte - [dapp](./src/dapp) - All you need Ethereum development tool. Build, test, fuzz, formally verify, debug & deploy solidity contracts. - [seth](./src/seth) - Ethereum CLI. Query contracts, send transactions, follow logs, slice & dice data. -- [hevm](./src/hevm) - Testing oriented EVM implementation. Debug, fuzz, or symbolically execute code against local or mainnet state. - [ethsign](./src/ethsign) - Sign Ethereum transactions from a local keystore or hardware wallet. ## Development Status @@ -19,6 +18,10 @@ dapptools is currently in a stage of clandestine development where support for t be deprived. The software can now be considered free as in free puppy. Users seeking guidance can explore using foundry as an alternative +hevm was previously maintained as a part of this repository, but has since been forked out by the +formal methods team at the ethereum foundation, and is now developed at +[ethereum/hevm](https://github.com/ethereum/hevm). + ## Installation Install Nix if you haven't already ([instructions](https://nixos.org/download.html)). Then install dapptools: @@ -26,7 +29,7 @@ Install Nix if you haven't already ([instructions](https://nixos.org/download.ht ### With flakes ``` -nix profile install github:dapphub/dapptools#{dapp,ethsign,hevm,seth} +nix profile install github:dapphub/dapptools#{dapp,ethsign,hevm,seth,solc} ``` Nix will offer to use the dapptools binary cache, which will speed up installs, @@ -52,20 +55,12 @@ nix-env -iA -f $(curl -sS https://api.github.com/repos/dapphub/dapptools/ If you instead want to build from `master`, change the url to `https://github.com/dapphub/dapptools/archive/master.tar.gz`. -### Prebuilt hevm binary - -Static binaries for linux and macos of hevm are available for each release at https://github.com/dapphub/dapptools/releases. - -Most functionality is available out of the box, but for symbolic execution you will need -[`solc`](https://github.com/ethereum/solidity) and ([`z3`](https://github.com/Z3Prover/z3/) or [`cvc4`](https://github.com/CVC4/CVC4) (or both)). - ## Getting started For more information about the tools, consult the individual README pages: - [seth](./src/seth/README.md) - [dapp](./src/dapp/README.md) -- [hevm](./src/hevm/README.md) - [ethsign](./src/ethsign/README.md) or use the `--help` flag for any tool. @@ -95,12 +90,6 @@ export ETH_RPC_URL=https://mainnet.infura.io/v3/$YOUR_API_KEY dapp address 0xab5801a7d398351b8be11c439e05c5b3259aec9b $(seth nonce 0xab5801a7d398351b8be11c439e05c5b3259aec9b) ``` -Symbolically explore the possible execution paths of a call to `dai.transfer(address,uint)`: -```sh -seth bundle-source 0x6b175474e89094c44da98b954eedeac495271d0f > daisrc.json && \ -hevm symbolic --address 0x6b175474e89094c44da98b954eedeac495271d0f --rpc $ETH_RPC_URL --debug --sig "transfer(address,uint256)" --json-file daisrc.json -``` - ## Contributing Contributions are always welcome! You may be interested in the diff --git a/default.nix b/default.nix index 02a69317f..740b8a44a 100644 --- a/default.nix +++ b/default.nix @@ -1,16 +1,28 @@ -{ system ? builtins.currentSystem , ... }: +{ system ? builtins.currentSystem, ... }: let - rev = "aa576357673d609e618d87db43210e49d4bb1789"; + lock = builtins.fromJSON (builtins.readFile ./flake.lock); + nixpkgs = builtins.fetchTarball { name = "nixpkgs-release-21.05"; - url = "https://github.com/nixos/nixpkgs/tarball/${rev}"; - sha256 = "1868s3mp0lwg1jpxsgmgijzddr90bjkncf6k6zhdjqihf0i1n2np"; + url = "https://github.com/nixos/nixpkgs/tarball/${lock.nodes.nixpkgs_2.locked.rev}"; + sha256 = lock.nodes.nixpkgs_2.locked.narHash; }; + ethereum-hevm = import (builtins.fetchTarball { + name = "ethereum-hevm"; + url = "https://github.com/ethereum/hevm/tarball/${lock.nodes.ethereum-hevm.locked.rev}"; + sha256 = lock.nodes.ethereum-hevm.locked.narHash; + }); in - # Now return the Nixpkgs configured to use our overlay. - import nixpkgs { - inherit system; - overlays = [(import ./overlay.nix)]; - } +# Now return the Nixpkgs configured to use our overlay. +import nixpkgs { + inherit system; + + overlays = [ + (import ./overlay.nix) + (final: prev: { + hevm = ethereum-hevm.packages.${system}.hevm; + }) + ]; +} diff --git a/flake.lock b/flake.lock index f47c497ed..6d8b7d24d 100644 --- a/flake.lock +++ b/flake.lock @@ -1,24 +1,126 @@ { "nodes": { + "ethereum-hevm": { + "inputs": { + "ethereum-tests": "ethereum-tests", + "flake-compat": "flake-compat", + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs", + "solidity": "solidity" + }, + "locked": { + "lastModified": 1677671403, + "narHash": "sha256-naxFA30C0IBaHiWGfRIXIcvAONUEMu3WozZGHZ50zyo=", + "owner": "ethereum", + "repo": "hevm", + "rev": "e65af03e692bb43531a6e278efcf77ed9f37c323", + "type": "github" + }, + "original": { + "owner": "ethereum", + "repo": "hevm", + "type": "github" + } + }, + "ethereum-tests": { + "flake": false, + "locked": { + "lastModified": 1668955227, + "narHash": "sha256-t9GV1TUfXr6xwgRvCaf43oGhBLdlYJwNCmaR4rIYV1M=", + "owner": "ethereum", + "repo": "tests", + "rev": "a16217cff68fa587a4a8b8b008e5cf374a6086b5", + "type": "github" + }, + "original": { + "owner": "ethereum", + "ref": "v11.2", + "repo": "tests", + "type": "github" + } + }, + "flake-compat": { + "flake": false, + "locked": { + "lastModified": 1668681692, + "narHash": "sha256-Ht91NGdewz8IQLtWZ9LCeNXMSXHUss+9COoqu6JLmXU=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "009399224d5e398d03b22badca40a37ac85412a1", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-utils": { + "locked": { + "lastModified": 1667395993, + "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, "nixpkgs": { "locked": { - "lastModified": 1622820998, - "narHash": "sha256-1wobInAwYtngN9M4ZqdcIOXWvoyvPt2vDI9TcOvQyKA=", + "lastModified": 1672059513, + "narHash": "sha256-4R7lESB3biVNyE6rXkjw3mhowzg4zTQgZElM4/dRUv8=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "1b71def42b74811323de2df52f180b795ec506fc", + "type": "github" + }, + "original": { + "owner": "nixos", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1677837732, + "narHash": "sha256-2sx+7soLVmMGndjD7qUuz+g4xtZZgZbjNXmEXzYlOJ4=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "aa576357673d609e618d87db43210e49d4bb1789", + "rev": "ea0dc57bb6d17b2e83929d5d8378281174a9a2a7", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "aa576357673d609e618d87db43210e49d4bb1789", "type": "github" } }, "root": { "inputs": { - "nixpkgs": "nixpkgs" + "ethereum-hevm": "ethereum-hevm", + "nixpkgs": "nixpkgs_2" + } + }, + "solidity": { + "flake": false, + "locked": { + "lastModified": 1670421565, + "narHash": "sha256-VCZDKQHnMsXu+ucsT5BLPYQoZ2FYjpyGbDVoDYjr1W8=", + "owner": "ethereum", + "repo": "solidity", + "rev": "1c8745c54a239d20b6fb0f79a8bd2628d779b27e", + "type": "github" + }, + "original": { + "owner": "ethereum", + "repo": "solidity", + "rev": "1c8745c54a239d20b6fb0f79a8bd2628d779b27e", + "type": "github" } } }, diff --git a/flake.nix b/flake.nix index afafbedcc..d22fb99a3 100644 --- a/flake.nix +++ b/flake.nix @@ -2,22 +2,19 @@ description = "dapptools"; inputs = { - # same as in default.nix - nixpkgs.url = "github:NixOS/nixpkgs/aa576357673d609e618d87db43210e49d4bb1789"; + nixpkgs.url = "github:NixOS/nixpkgs"; + ethereum-hevm.url = "github:ethereum/hevm"; }; nixConfig = { - # required to build hevm - allow-import-from-derivation = true; extra-substituters = [ "https://dapp.cachix.org" ]; extra-trusted-public-keys = [ "dapp.cachix.org-1:9GJt9Ja8IQwR7YW/aF0QvCa6OmjGmsKoZIist0dG+Rs=" ]; + log-lines = 50; }; - outputs = { self, nixpkgs }: + outputs = { self, nixpkgs, ethereum-hevm }: let supportedSystems = [ - "aarch64-linux" - "x86_64-darwin" "x86_64-linux" ]; @@ -25,20 +22,38 @@ forAllSystems = nixpkgs.lib.genAttrs supportedSystems; nixpkgsFor = forAllSystems (system: import nixpkgs { inherit system; - overlays = [ (import ./overlay.nix) ]; + overlays = [ + (import ./overlay.nix) + (final: prev: { + hevm = ethereum-hevm.packages.${system}.hevm; + }) + ]; }); in { packages = forAllSystems (system: { - inherit (nixpkgsFor.${system}) dapp ethsign hevm seth; + inherit (nixpkgsFor.${system}) dapp ethsign hevm seth solc solc-versions solc-static-versions; }); apps = forAllSystems (system: - nixpkgs.lib.genAttrs [ "dapp" "ethsign" "hevm" "seth" ] (name: { + nixpkgs.lib.genAttrs [ "dapp" "ethsign" "hevm" "seth" "solc" ] (name: { type = "app"; program = "${self.packages.${system}.${name}}/bin/${name}"; })); + + devShells = + forAllSystems (system: { + default = nixpkgs.legacyPackages.${system}.mkShellNoCC { + name = "dapp"; + buildInputs = with nixpkgsFor.${system}; [ + dapp + ethsign + seth + solc + ]; + }; + }); }; } diff --git a/haskell.nix b/haskell.nix index 7e895bee4..2c09820c6 100644 --- a/haskell.nix +++ b/haskell.nix @@ -13,41 +13,30 @@ in self-hs: super-hs: pkgs.haskell.lib.dontCheck (self-hs.callCabal2nix x y {}); + # FIXME: hevm is broken in our current nixpkgs pin, so we pull a newer one + # here and then use that to build hevm-0.50.0. This should be removed once + # we migrate the main nixpkgs pin to a newer version. + pkgs-2022-11 = import (pkgs.fetchFromGitHub { + owner = "nixos"; + repo = "nixpkgs"; + rev = "dac57a4eccf1442e8bf4030df6fcbb55883cb682"; + sha256 = "sha256-C15oAtyupmLB3coZY7qzEHXjhtUx/+77olVdqVMruAg="; + }) { system = pkgs.system; }; + myHaskell = pkgs-2022-11.haskellPackages.override { + overrides = self: super: { + hevm = pkgs.haskell.lib.dontCheck (self.callHackageDirect { + pkg = "hevm"; + ver = "0.50.0"; + sha256 = "sha256-ju/ZuacGneQR6tJLv7gwyMj7+u8GGQ5JcYm/XXi53yI="; + } {}); + secp256k1 = pkgs.secp256k1; + }; + }; + in { restless-git = dontCheck "restless-git" (./src/restless-git); - hevm = pkgs.haskell.lib.dontHaddock (( - self-hs.callCabal2nix "hevm" (./src/hevm) { - # Haskell libs with the same names as C libs... - # Depend on the C libs, not the Haskell libs. - # These are system deps, not Cabal deps. - inherit (pkgs) secp256k1; - } - ).overrideAttrs (attrs: { - postInstall = - if wrapped - then - '' - wrapProgram $out/bin/hevm --prefix PATH \ - : "${lib.makeBinPath (with pkgs; [bash coreutils git solc])}" - '' - else ""; - - enableSeparateDataOutput = true; - buildInputs = attrs.buildInputs ++ [pkgs.solc] ++ (if wrapped then [] else [pkgs.z3 pkgs.cvc4]); - nativeBuildInputs = attrs.nativeBuildInputs ++ [pkgs.makeWrapper]; - configureFlags = attrs.configureFlags ++ [ - "--ghc-option=-O2" - ] ++ - (if stdenv.isDarwin then [] else - if shared then [] else [ - "--enable-executable-static" - "--extra-lib-dirs=${pkgs.gmp.override { withStatic = true; }}/lib" - "--extra-lib-dirs=${pkgs.glibc.static}/lib" - "--extra-lib-dirs=${pkgs.libff.override { enableStatic = true; }}/lib" - "--extra-lib-dirs=${pkgs.ncurses.override {enableStatic = true; }}/lib" - "--extra-lib-dirs=${pkgs.zlib.static}/lib" - "--extra-lib-dirs=${pkgs.libffi.overrideAttrs (old: { dontDisableStatic = true; })}/lib" - ]); - })); + eth-utils = pkgs.haskell.lib.dontHaddock ( + myHaskell.callCabal2nix "eth-utils" (./src/eth-utils) {} + ); } diff --git a/nix/geth.nix b/nix/geth.nix deleted file mode 100644 index 77be27cc9..000000000 --- a/nix/geth.nix +++ /dev/null @@ -1,60 +0,0 @@ -{ lib, stdenv, buildGoModule, fetchFromGitHub, libobjc ? null, IOKit ? null }: - -let - # A list of binaries to put into separate outputs - bins = [ - "geth" - "clef" - ]; - -in buildGoModule rec { - pname = "go-ethereum"; - version = "1.10.6"; - - src = fetchFromGitHub { - owner = "ethereum"; - repo = pname; - rev = "v${version}"; - sha256 = "sha256-4lapkoxSKdXlD6rmUxnlSKrfH+DeV6/wV05CqJjuzjA="; - }; - - runVend = true; - vendorSha256 = "sha256-5qi01y0SIEI0WRYu2I2RN94QFS8rrlioFvnRqqp6wtk="; - - doCheck = false; - - outputs = [ "out" ] ++ bins; - - # Move binaries to separate outputs and symlink them back to $out - postInstall = lib.concatStringsSep "\n" ( - builtins.map (bin: "mkdir -p \$${bin}/bin && mv $out/bin/${bin} \$${bin}/bin/ && ln -s \$${bin}/bin/${bin} $out/bin/") bins - ); - - subPackages = [ - "cmd/abidump" - "cmd/abigen" - "cmd/bootnode" - "cmd/checkpoint-admin" - "cmd/clef" - "cmd/devp2p" - "cmd/ethkey" - "cmd/evm" - "cmd/faucet" - "cmd/geth" - "cmd/p2psim" - "cmd/puppeth" - "cmd/rlpdump" - "cmd/utils" - ]; - - # Fix for usb-related segmentation faults on darwin - propagatedBuildInputs = - lib.optionals stdenv.isDarwin [ libobjc IOKit ]; - - meta = with lib; { - homepage = "https://geth.ethereum.org/"; - description = "Official golang implementation of the Ethereum protocol"; - license = with licenses; [ lgpl3Plus gpl3Plus ]; - maintainers = with maintainers; [ adisbladis lionello xrelkd RaghavSood ]; - }; -} diff --git a/nix/hevm-tests/default.nix b/nix/hevm-tests/default.nix deleted file mode 100644 index 15b91e107..000000000 --- a/nix/hevm-tests/default.nix +++ /dev/null @@ -1,19 +0,0 @@ -{ pkgs }: -let - solc = "${pkgs.solc-static-versions.solc_0_8_6}/bin/solc-0.8.6"; - solidity = pkgs.fetchFromGitHub { - owner = "ethereum"; - repo = "solidity"; - rev = "b8d736ae0c506b1b3cf5d2456af67e8dc2c0ca8e"; # v0.6.7 - sha256 = "1zqfcfgy70hmckxb3l59rabdpzj7gf1vzg6kkw4xz0c6lzy7mrpz"; - }; - runWithSolver = file : solver : (import file) { inherit pkgs solc solidity solver; }; -in - pkgs.recurseIntoAttrs { - yulEquivalence-z3 = runWithSolver ./yul-equivalence.nix "z3"; - yulEquivalence-cvc4 = runWithSolver ./yul-equivalence.nix "cvc4"; - - # z3 takes 3hrs to run these tests on a fast machine, and even then ~180 timeout - #smtChecker-z3 = runWithSolver ./smt-checker.nix "z3"; - smtChecker-cvc4 = runWithSolver ./smt-checker.nix "cvc4"; - } diff --git a/nix/hevm-tests/smt-checker.nix b/nix/hevm-tests/smt-checker.nix deleted file mode 100644 index 2d96812c1..000000000 --- a/nix/hevm-tests/smt-checker.nix +++ /dev/null @@ -1,410 +0,0 @@ -/* - This file explores the contracts in the test suite for the solc SMTChecker module - with hevm and compares the results with those found by the SMTChecker -*/ -{ pkgs, solidity, solc, solver }: - -let - - # --- binaries --- - - bc = "${pkgs.bc}/bin/bc"; - basename = "${pkgs.coreutils}/bin/basename"; - cat = "${pkgs.coreutils}/bin/cat"; - echo = "${pkgs.coreutils}/bin/echo"; - grep = "${pkgs.gnugrep}/bin/grep"; - hevm = "${pkgs.hevm}/bin/hevm"; - jq = "${pkgs.jq}/bin/jq"; - mkdir = "${pkgs.coreutils}/bin/mkdir"; - mktemp = "${pkgs.coreutils}/bin/mktemp"; - sed = "${pkgs.gnused}/bin/sed"; - tee = "${pkgs.coreutils}/bin/tee"; - tr = "${pkgs.coreutils}/bin/tr"; - timeout = "${pkgs.coreutils}/bin/timeout"; - - # --- test classification --- - - bounded = [ - - "functions/functions_recursive.sol" - "functions/functions_recursive_indirect.sol" - "functions/recursive_multi_return.sol" - "invariants/loop_basic.sol" - "invariants/loop_basic_for.sol" - "loops/do_while_1_fail.sol" - "loops/for_loop_array_assignment_storage_memory.sol" - "loops/for_loop_array_assignment_storage_storage.sol" - "loops/while_1_infinite.sol" - "loops/while_1.sol" - "loops/while_loop_simple_5.sol" - "loops/do_while_1_false_positives.sol" - "loops/while_loop_array_assignment_storage_storage.sol" - "loops/while_nested_break.sol" - "loops/while_nested_break_fail.sol" - "operators/delete_array.sol" - "operators/delete_array_index_2d.sol" - "operators/delete_array_2d.sol" - "types/array_dynamic_3_fail.sol" - ]; - - ignored = [ - - # --- constructor arguments --- - - "functions/constructor_hierarchy_3.sol" - "functions/constructor_hierarchy_4.sol" - "functions/constructor_hierarchy_diamond_2.sol" - "functions/constructor_hierarchy_diamond_3.sol" - "functions/constructor_hierarchy_diamond_empty_middle.sol" - "functions/constructor_hierarchy_diamond.sol" - "functions/constructor_hierarchy_empty_chain.sol" - "functions/constructor_hierarchy_empty_middle_no_invocation.sol" - "functions/constructor_hierarchy_empty_middle.sol" - "functions/constructor_hierarchy_mixed_chain_empty_base.sol" - "functions/constructor_hierarchy_mixed_chain.sol" - "functions/constructor_hierarchy_mixed_chain_local_vars.sol" - "functions/constructor_hierarchy_mixed_chain_with_params.sol" - "functions/constructor_hierarchy_mixed_chain_with_params_2.sol" - "functions/constructor_simple.sol" - "functions/constructor_state_value_inherited.sol" - "functions/constructor_state_value.sol" - "inheritance/constructor_hierarchy_mixed_chain_with_params.sol" - "inheritance/constructor_state_variable_init_chain_run_all.sol" - "inheritance/constructor_state_variable_init_chain_run_all_2.sol" - - # --- infinite loops --- - - "functions/functions_trivial_condition_for.sol" - "functions/functions_trivial_condition_for_only_call.sol" - "functions/functions_trivial_condition_while.sol" - "functions/functions_trivial_condition_while_only_call.sol" - "loops/do_while_continue.sol" - "loops/for_loop_1.sol" - "loops/for_loop_2.sol" - "loops/for_loop_3.sol" - "loops/for_loop_5.sol" - "loops/for_loop_6.sol" - "loops/for_loop_trivial_condition_1.sol" - "loops/for_loop_trivial_condition_2.sol" - "loops/for_loop_trivial_condition_3.sol" - "loops/while_2_fail.sol" - "loops/while_loop_simple_2.sol" - "loops/while_loop_simple_3.sol" - "loops/while_loop_simple_4.sol" - "loops/while_1.sol" - "loops/while_1_infinite.sol" - - # --- hevm timeout --- - - "types/array_dynamic_3_fail.sol" - "types/array_aliasing_storage_1.sol" - "types/array_aliasing_memory_1.sol" - "types/array_aliasing_memory_2.sol" - "types/array_aliasing_memory_3.sol" - "loops/do_while_1_false_positives.sol" - - # --- unsupported opcodes --- - - # OpExtcodesize - "functions/this_fake.sol" - "functions/functions_external_1.sol" - "functions/functions_external_2.sol" - "functions/functions_external_3.sol" - "functions/functions_external_4.sol" - "typecast/function_type_to_function_type_external.sol" - - # OpJump - "complex/slither/external_function.sol" - - # OpCalldatacopy - "loops/for_loop_array_assignment_memory_memory.sol" - "loops/for_loop_array_assignment_memory_storage.sol" - "loops/while_loop_array_assignment_memory_memory.sol" - "loops/while_loop_array_assignment_memory_storage.sol" - "types/address_call.sol" - "types/address_delegatecall.sol" - "types/address_staticcall.sol" - "types/array_aliasing_storage_2.sol" - "types/array_aliasing_storage_3.sol" - "types/array_aliasing_storage_5.sol" - "types/array_branch_1d.sol" - "types/array_branches_1d.sol" - "types/array_dynamic_parameter_1.sol" - "types/array_dynamic_parameter_1_fail.sol" - "types/bytes_1.sol" - "types/bytes_2.sol" - "types/bytes_2_fail.sol" - "types/mapping_unsupported_key_type_1.sol" - "types/function_type_array_as_reference_type.sol" - - # OpBlockhash - "special/blockhash.sol" - - # OpBalance - "types/address_balance.sol" - "types/address_transfer.sol" - "types/address_transfer_2.sol" - "types/address_transfer_insufficient.sol" - - # --- missing hevm coverage --- - - # contract level knowledge required - "functions/internal_call_with_assertion_1.sol" - "functions/internal_multiple_calls_with_assertion_1.sol" - "inheritance/constructor_state_variable_init_chain_run_all.sol" - "inheritance/implicit_only_constructor_hierarchy.sol" - "inheritance/implicit_constructor_hierarchy.sol" - "invariants/state_machine_1.sol" - "types/mapping_4.sol" - - # knowledge of the solidity memory model required - "types/array_static_aliasing_memory_5.sol" - - # --- missing smt checker coverage --- - - # potential out of bounds array access - "operators/delete_array_index.sol" - "operators/delete_array.sol" - "operators/delete_function.sol" - "operators/delete_array_2d.sol" - "types/array_branches_2d.sol" - "types/array_branches_3d.sol" - "types/array_dynamic_1.sol" - "types/array_dynamic_2.sol" - "types/array_static_2.sol" - "types/array_static_3.sol" - "types/tuple_assignment_array.sol" - "types/array_dynamic_3.sol" - "types/array_static_1.sol" - - # bounds checking on enum args during abi decoding - "typecast/enum_to_uint_max_value.sol" - "types/enum_explicit_values.sol" - "types/enum_transitivity.sol" - - # --- smt checker false positives --- - - "typecast/cast_different_size_1.sol" - "typecast/cast_larger_3.sol" - "typecast/cast_smaller_2.sol" - "typecast/cast_smaller_3.sol" - "types/mapping_as_parameter_1.sol" - "types/mapping_as_local_var_1.sol" - - # --- solc 0.8 --- - - "modifiers/modifier_code_after_placeholder.sol" # assertion can't trigger post 0.8 due to overflow checking - "special/many.sol" # no longer compiles - - ]; - - # --- test scripts --- - - strings = { - executing = "Executing test:"; - pass = "PASS: hevm and SMTChecker agree!"; - ignore = "SKIP: test ignored"; - smtReports = "FAIL: SMTChecker reports assertion violation whereas HEVM reports safe."; - hevmReports = "FAIL: SMTChecker reports safe whereas HEVM reports assertion violation."; - timeout = "FAIL: hevm timeout"; - hevmAssertionViolation = "Assertion violation found"; - hevmErrorInBranch = "branch(es) errored while exploring"; - hevmCouldNotExplore = "FAIL: hevm was unable to explore the contract"; - smtCheckerFailed = "SKIP: smtChecker failed"; - }; - - smtCheckerTests = "${solidity}/test/libsolidity/smtCheckerTests"; - - testName = pkgs.writeShellScript "testName" '' - ${echo} "$1" | ${grep} -oP "^${smtCheckerTests}/\K.*" - ''; - - divider = pkgs.writeShellScript "divider" '' - ${echo} - ${echo} ============================================================================================ - ${echo} - ''; - - # Takes one Solidity file, compiles it to bytecode and explores `hevm - # symbolic` on all contracts within. - # $1 == input file - # $2 == hevm smt backend - checkWithHevm = pkgs.writeShellScript "checkWithHevm" '' - - # write json file to store for later debugging - testName=$(${testName} $1) - json=$out/jsonFiles/$testName.json - ${mkdir} -p $(${echo} "''${json%/*}/") - - ${solc} --combined-json=srcmap,srcmap-runtime,bin,bin-runtime,ast,metadata,storage-layout,abi $1 2> /dev/null > $json - - contracts=($(${cat} $json | ${jq} .contracts | ${jq} keys | ${jq} -r '. | @sh' | ${tr} -d \')) - - explore() { - set -x - hevm_output=$(${timeout} 90s ${hevm} symbolic --smttimeout 20000 --code "$1" --solver "$2" --json-file "$3" $4 2>&1) - status=$? - set +x - - # handle timeouts - if [[ $status == 124 ]]; then ${echo} && ${echo} "${strings.timeout}"; fi - - # handle non assertion related hevm failures - if [[ $status == 1 ]]; then - ${grep} -q '${strings.hevmAssertionViolation}' <<< "$hevm_output" - if [ $? == 0 ]; then return; fi - ${echo} "${strings.hevmCouldNotExplore}" - fi - - # handle errors in branches - if [[ $status == 0 ]]; then - ${grep} -q '${strings.hevmErrorInBranch}' <<< "$hevm_output" - if [ $? == 1 ]; then return; fi - ${echo} "${strings.hevmCouldNotExplore}" - fi - } - - for contract in "''${contracts[@]}"; do - ${echo} - ${echo} --- exploring $(basename $contract) --- - - ${echo} - ${echo} exploring init bytecode: - bin=$(${jq} -r --arg c $contract -c '.contracts[$c]."bin"' $json) - explore "$bin" "$2" "$json" "--create" - - iterations="" - boundedTests=(${toString bounded}) - if [[ " ''${boundedTests[@]} " =~ " ''${testName} " ]]; then - iterations="--max-iterations 3" - fi - - ${echo} - ${echo} exploring runtime bytecode: - bin_runtime=$(${jq} -r --arg c $contract -c '.contracts[$c]."bin-runtime"' $json) - explore "$bin_runtime" "$2" "$json" "$iterations" - done - - exit 0 - ''; - - # Takes one Solidity file in the format of an SMTChecker test, - # runs `hevm symbolic` on it and compares results against the SMTChecker expectations. - # $1 == input file - # $2 == hevm smt backend - runSingleTest = pkgs.writeShellScript "runSingleTest" '' - print_test() { - ${echo} - ${echo} "*** Input File: $(${testName} $1) ***" - ${echo} - ${cat} "$1" - } - - testName=$(${testName} $1) - - ${divider} - ${echo} "${strings.executing} $(${testName} $1)" - - ignoredTests=(${toString ignored}) - if [[ " ''${ignoredTests[@]} " =~ " ''${testName} " ]]; then - ${echo} "${strings.ignore}" - exit 0 - fi - - ${grep} -q 'Error trying to invoke SMT solver.' $1 - if [ $? == 0 ]; then ${echo} ${strings.smtCheckerFailed} && exit; fi - ${grep} -q 'Assertion checker does not yet implement' $1 - if [ $? == 0 ]; then ${echo} ${strings.smtCheckerFailed} && exit; fi - ${grep} -q 'Assertion checker does not yet support' $1 - if [ $? == 0 ]; then ${echo} ${strings.smtCheckerFailed} && exit; fi - - hevm_output=$(${checkWithHevm} $1 $2 2>&1) - echo "$hevm_output" - - ${grep} -q '${strings.timeout}' <<< "$hevm_output" - if [ $? == 0 ]; then print_test "$1" && exit; fi - ${grep} -q '${strings.hevmCouldNotExplore}' <<< "$hevm_output" - if [ $? == 0 ]; then print_test "$1" && exit; fi - - ${grep} -q '${strings.hevmAssertionViolation}' <<< "$hevm_output" - hevm_violation=$? - - ${grep} -q 'Assertion violation happens' $1 - smtchecker_assertion_violation=$? - ${grep} -q 'Division by zero happens here' $1 - smtchecker_division_by_zero=$? - - smtchecker_violation=1 - if [ $smtchecker_assertion_violation -eq 0 ] || [ $smtchecker_division_by_zero -eq 0 ]; then - smtchecker_violation=0 - fi - - if [ $hevm_violation -ne 0 ] && [ $smtchecker_violation -eq 0 ]; then - ${echo} - ${echo} "${strings.smtReports}" - print_test "$1" - exit - elif [ $hevm_violation -eq 0 ] && [ $smtchecker_violation -ne 0 ]; then - ${echo} - ${echo} "${strings.hevmReports}" - print_test "$1" - exit - fi - - ${echo} - ${echo} ${strings.pass} - ''; - - runAllTests = pkgs.writeShellScript "runAllTests-${solver}" '' - for filename in ${smtCheckerTests}/**/*.sol; do - ${runSingleTest} $filename ${solver} - done - - ${divider} - ${echo} "Time Taken (${solver}):" - ${echo} --------------------------------- - ${echo} - - exit 0 - ''; -in -pkgs.runCommand "smtCheckerTests-${solver}" {} '' - mkdir $out - results=$out/results - - time ${runAllTests} | ${tee} $results - - set +e - total="$(${grep} -c '${strings.executing}' $results)" - passed="$(${grep} -c '${strings.pass}' $results)" - ignored="$(${grep} -c '${strings.ignore}' $results)" - smt_failed="$(${grep} -c '${strings.smtCheckerFailed}' $results)" - hevm_failed="$(${grep} -c '${strings.hevmCouldNotExplore}' $results)" - smt_reports="$(${grep} -c '${strings.smtReports}' $results)" - hevm_reports="$(${grep} -c '${strings.hevmReports}' $results)" - hevm_timeout="$(${grep} -c '${strings.timeout}' $results)" - set -e - - ${echo} - ${echo} "Summary (${solver}):" - ${echo} --------------------------------- - ${echo} - ${echo} ran: $total - ${echo} passed: $passed - ${echo} skipped: $(${bc} <<< "$ignored + $smt_failed") - ${echo} 'failed (smt reports assertion, hevm reports safe):' $smt_reports - ${echo} 'failed (hevm reports assertion, smt reports safe):' $hevm_reports - ${echo} hevm timeout: $hevm_timeout - ${echo} hevm failure: $hevm_failed - ${echo} - - if [ $hevm_timeout != 0 ] || \ - [ $smt_reports != 0 ] || \ - [ $hevm_reports != 0 ] - then - exit 1 - else - exit 0 - fi -'' - diff --git a/nix/hevm-tests/yul-equivalence.nix b/nix/hevm-tests/yul-equivalence.nix deleted file mode 100644 index 33d047c1f..000000000 --- a/nix/hevm-tests/yul-equivalence.nix +++ /dev/null @@ -1,378 +0,0 @@ -/* - This file runs `hevm equivalence` against the yul optimizer test suite from the solidity repo. - This is a corpus of ~400 tests used to ensure that the yul optimizer produces equivalent code. -*/ - -{ pkgs, solidity, solc, solver }: - -let - - # --- binaries --- - - awk = "${pkgs.gawk}/bin/awk"; - cat = "${pkgs.coreutils}/bin/cat"; - echo = "${pkgs.coreutils}/bin/echo"; - grep = "${pkgs.gnugrep}/bin/grep"; - hevm = "${pkgs.hevm}/bin/hevm"; - mkdir = "${pkgs.coreutils}/bin/mkdir"; - mktemp = "${pkgs.coreutils}/bin/mktemp"; - rm = "${pkgs.coreutils}/bin/rm"; - sed = "${pkgs.gnused}/bin/sed"; - tee = "${pkgs.coreutils}/bin/tee"; - timeout = "${pkgs.coreutils}/bin/timeout"; - - # --- test classification ---- - - ignored = [ - - # --- timeout (investigate) ---- - - "controlFlowSimplifier/terminating_for_nested.yul" - "controlFlowSimplifier/terminating_for_nested_reversed.yul" - - # --- unbounded loop --- - - "commonSubexpressionEliminator/branches_for.yul" - "commonSubexpressionEliminator/loop.yul" - "conditionalSimplifier/clear_after_if_continue.yul" - "conditionalSimplifier/no_opt_if_break_is_not_last.yul" - "conditionalUnsimplifier/clear_after_if_continue.yul" - "conditionalUnsimplifier/no_opt_if_break_is_not_last.yul" - "expressionSimplifier/inside_for.yul" - "forLoopConditionIntoBody/cond_types.yul" - "forLoopConditionIntoBody/simple.yul" - "fullSimplify/inside_for.yul" - "fullSuite/devcon_example.yul" - "fullSuite/loopInvariantCodeMotion.yul" - "fullSuite/no_move_loop_orig.yul" - "loadResolver/loop.yul" - "loopInvariantCodeMotion/multi.yul" - "loopInvariantCodeMotion/recursive.yul" - "loopInvariantCodeMotion/simple.yul" - "redundantAssignEliminator/for_branch.yul" - "redundantAssignEliminator/for_break.yul" - "redundantAssignEliminator/for_continue.yul" - "redundantAssignEliminator/for_decl_inside_break_continue.yul" - "redundantAssignEliminator/for_deep_noremove.yul" - "redundantAssignEliminator/for_deep_simple.yul" - "redundantAssignEliminator/for_multi_break.yul" - "redundantAssignEliminator/for_nested.yul" - "redundantAssignEliminator/for_rerun.yul" - "redundantAssignEliminator/for_stmnts_after_break_continue.yul" - "rematerialiser/branches_for1.yul" - "rematerialiser/branches_for2.yul" - "rematerialiser/for_break.yul" - "rematerialiser/for_continue.yul" - "rematerialiser/for_continue_2.yul" - "rematerialiser/for_continue_with_assignment_in_post.yul" - "rematerialiser/no_remat_in_loop.yul" - "ssaTransform/for_reassign_body.yul" - "ssaTransform/for_reassign_init.yul" - "ssaTransform/for_reassign_post.yul" - "ssaTransform/for_simple.yul" - - # --- unexpected symbolic arg --- - - # OpCreate2 - "expressionSimplifier/create2_and_mask.yul" - - # OpCreate - "expressionSimplifier/create_and_mask.yul" - "expressionSimplifier/large_byte_access.yul" - - # OpMload - "yulOptimizerTests/expressionSplitter/inside_function.yul" - "fullInliner/double_inline.yul" - "fullInliner/inside_condition.yul" - "fullInliner/large_function_multi_use.yul" - "fullInliner/large_function_single_use.yul" - "fullInliner/no_inline_into_big_global_context.yul" - "fullSimplify/invariant.yul" - "fullSuite/abi_example1.yul" - "ssaAndBack/for_loop.yul" - "ssaAndBack/multi_assign_multi_var_if.yul" - "ssaAndBack/multi_assign_multi_var_switch.yul" - "ssaAndBack/two_vars.yul" - "ssaTransform/multi_assign.yul" - "ssaTransform/multi_decl.yul" - "expressionSplitter/inside_function.yul" - "fullSuite/ssaReverseComplex.yul" - - # OpMstore - "commonSubexpressionEliminator/function_scopes.yul" - "commonSubexpressionEliminator/variable_for_variable.yul" - "expressionSplitter/trivial.yul" - "fullInliner/multi_return.yul" - "fullSimplify/constant_propagation.yul" - "fullSimplify/identity_rules_complex.yul" - "fullSuite/medium.yul" - "loadResolver/memory_with_msize.yul" - "loadResolver/merge_known_write.yul" - "loadResolver/merge_known_write_with_distance.yul" - "loadResolver/merge_unknown_write.yul" - "loadResolver/reassign_value_expression.yul" - "loadResolver/second_mstore_with_delta.yul" - "loadResolver/second_store_with_delta.yul" - "loadResolver/simple.yul" - "loadResolver/simple_memory.yul" - "fullSuite/ssaReverse.yul" - "rematerialiser/cheap_caller.yul" - "rematerialiser/non_movable_instruction.yul" - "ssaAndBack/multi_assign.yul" - "ssaAndBack/multi_assign_if.yul" - "ssaAndBack/multi_assign_switch.yul" - "ssaAndBack/simple.yul" - "ssaReverser/simple.yul" - - # OpMstore8 - "loadResolver/memory_with_different_kinds_of_invalidation.yul" - - # OpRevert - "ssaAndBack/ssaReverse.yul" - "redundantAssignEliminator/for_continue_3.yul" - "controlFlowSimplifier/terminating_for_revert.yul" - - # --- invalid test --- - # https://github.com/ethereum/solidity/issues/9500 - - "commonSubexpressionEliminator/object_access.yul" - "expressionSplitter/object_access.yul" - "fullSuite/stack_compressor_msize.yul" - "varNameCleaner/function_names.yul" - - # --- stack too deep --- - - "fullSuite/abi2.yul" - "fullSuite/aztec.yul" - "stackCompressor/inlineInBlock.yul" - "stackCompressor/inlineInFunction.yul" - "stackCompressor/unusedPrunerWithMSize.yul" - "wordSizeTransform/function_call.yul" - "fullInliner/no_inline_into_big_function.yul" - - # --- wrong number of args --- - - "wordSizeTransform/functional_instruction.yul" - "wordSizeTransform/if.yul" - "wordSizeTransform/or_bool_renamed.yul" - "wordSizeTransform/switch_1.yul" - "wordSizeTransform/switch_2.yul" - "wordSizeTransform/switch_3.yul" - "wordSizeTransform/switch_4.yul" - "wordSizeTransform/switch_5.yul" - - # --- typed yul --- - - "expressionSplitter/typed.yul" - "expressionInliner/simple.yul" - "expressionInliner/with_args.yul" - "disambiguator/variables_inside_functions.yul" - "disambiguator/switch_statement.yul" - "disambiguator/if_statement.yul" - "disambiguator/for_statement.yul" - "disambiguator/funtion_call.yul" - "disambiguator/long_names.yul" - "disambiguator/variables.yul" - "disambiguator/variables_clash.yul" - "conditionalSimplifier/add_correct_type.yul" - "conditionalSimplifier/add_correct_type_wasm.yul" - "fullInliner/multi_return_typed.yul" - "functionGrouper/empty_block.yul" - "functionGrouper/multi_fun_mixed.yul" - "functionGrouper/nested_fun.yul" - "functionGrouper/single_fun.yul" - "functionHoister/empty_block.yul" - "functionHoister/multi_mixed.yul" - "functionHoister/nested.yul" - "functionHoister/single.yul" - "mainFunction/empty_block.yul" - "mainFunction/multi_fun_mixed.yul" - "mainFunction/nested_fun.yul" - "mainFunction/single_fun.yul" - "ssaTransform/typed.yul" - "ssaTransform/typed_for.yul" - "ssaTransform/typed_switch.yul" - "varDeclInitializer/typed.yul" - ]; - - # --- test scripts --- - - # Compiles a yul file to evm and prints the resulting bytecode to stdout - # Propogates the status code of the solc invocation - compile = pkgs.writeShellScript "compile" '' - out=$(${mktemp}) - ${solc} --yul --yul-dialect evm $1 > $out 2>&1 - status=$? - ${cat} $out | ${awk} 'f{print;f=0} /Binary representation:/{f=1}' - exit $status - ''; - - # takes a yul program and ensures memory is symbolic by prepending - # `calldatacopy(0,0,1024)`. (calldata is symbolic, but memory starts empty). - # This forces the exploration of more branches, and makes the test vectors a - # little more thorough. - forceSymbolicMemory = pkgs.writeShellScript "forceSymbolicMemory" '' - in=$(${cat} /dev/stdin) - - # empty programs - if [ "$in" == "{ }" ]; then - ${echo} "$in" - exit 0 - fi - - # object notation - # add a calldatacopy after all 'code {' - if [ "$(${echo} $in | head -n 1 | ${awk} '{print $1;}')" == "object" ]; then - ${echo} "$in" | ${sed} '/code\ {/ a calldatacopy(0,0,1024)' - exit 0 - fi - - # simple notation - # add a calldatacopy after the first { - ${echo} "$in" | ${sed} -z '0,/^\s*{/s//{\ncalldatacopy(0,0,1024)/' - ''; - - # Takes two Yul files, compiles them to EVM bytecode and checks equivalence. - compareTwoFiles = pkgs.writeShellScript "runSingleTest" '' - a_bin=$(${compile} $1) - if [ $? -eq 1 ] - then - ${echo} "Could not compile first Yul source. ($1)" - ${cat} $1 - exit - fi - - b_bin=$(${compile} $2) - if [ $? -eq 1 ] - then - ${echo} "Could not compile second Yul source. ($2)" - ${cat} $2 - exit - fi - - if [[ "$a_bin" == "$b_bin" ]] - then - ${echo} "Bytecodes are the same." - exit - fi - - ${echo} "Checking bytecode equivalence: $a_bin vs $b_bin" - ${timeout} 30s ${hevm} equivalence --solver $3 \ - --code-a "$a_bin" \ - --code-b "$b_bin" \ - --smttimeout 20000 - status=$? - - if [[ $status == 1 ]] - then - ${echo} hevm execution failed - ${echo} "file1:" - ${cat} $1 - ${echo} "-------------" - ${echo} "file2:" - ${cat} $2 - exit - fi - - if [[ $status == 124 ]] - then - ${echo} "hevm timeout." - ${echo} "file1:" - ${cat} $1 - ${echo} "-------------" - ${echo} "file2:" - ${cat} $2 - exit - fi - ''; - - runAllTests = let - prefix = "${solidity}/test/libyul/yulOptimizerTests"; - in pkgs.writeShellScript "runAllTests" '' - solver=$1 - - check_equiv() - { - # Takes one file which follows the Solidity Yul optimizer unit tests format, - # extracts both the nonoptimized and the optimized versions, and checks equivalence. - - ignoredTests=(${toString ignored}) - testName=$(${echo} "$1" | ${grep} -oP "^${prefix}/\K.*") - - ${echo} "---------------------------------------------" - ${echo} "executing test: $testName with $2" - - if [[ " ''${ignoredTests[@]} " =~ " ''${testName} " ]]; then - ${echo} "$testName is ignored, skipping" - return 0 - fi - - file1=$(${mktemp}) - ${cat} $1 \ - | ${sed} '/^\/\//d' \ - | ${sed} -e '/^$/d' \ - | ${forceSymbolicMemory} \ - > $file1 - - file2=$(${mktemp}) - cat $1 \ - | ${sed} '0,/^\/\/ step:/d' \ - | ${sed} -e 's!\/\/!!' \ - | ${sed} -e '/^$/d' \ - | ${sed} 's/^.//' \ - | ${forceSymbolicMemory} \ - > $file2 - - ${compareTwoFiles} $file1 $file2 $2 - ${rm} $file1 $file2 - } - - for filename in ${prefix}/**/*.yul; do - check_equiv $filename $solver - done - - ${echo} - ${echo} "Time taken (${solver}):" - ${echo} ------------------------------------------- - ''; - -in -pkgs.runCommand "yulEquivalence-${solver}" {} '' - results=$out - time ${runAllTests} ${solver} | ${tee} $out - - ${echo} - ${echo} "Summary (${solver}):" - ${echo} ------------------------------------------- - - set +e - total="$(${grep} -c 'executing test:' $results)" - passed="$(${grep} -c 'No discrepancies found' $results)" - ignored="$(${grep} -c 'is ignored, skipping' $results)" - same_bytecode="$(${grep} -c 'Bytecodes are the same' $results)" - no_compile_first="$(${grep} -c 'Could not compile first Yul source' $results)" - no_compile_second="$(${grep} -c 'Could not compile second Yul source' $results)" - hevm_timeout="$(${grep} -c 'hevm timeout' $results)" - hevm_failed="$(${grep} -c 'hevm execution failed' $results)" - set -e - - ${echo} ran: $total - ${echo} passed: $passed - ${echo} ignored: $ignored - ${echo} same bytecode: $same_bytecode - ${echo} could not compile first program: $no_compile_first - ${echo} could not compile second program: $no_compile_second - ${echo} hevm timeout: $hevm_timeout - ${echo} hevm execution failed: $hevm_failed - ${echo} - - if [ $no_compile_first != 0 ] || \ - [ $no_compile_second != 0 ] || \ - [ $hevm_timeout != 0 ] || \ - [ $hevm_failed != 0 ] - then - exit 1 - else - exit 0 - fi -'' diff --git a/nix/solc-static.nix b/nix/solc-static.nix index 8ea194ea3..3c7f7a342 100644 --- a/nix/solc-static.nix +++ b/nix/solc-static.nix @@ -1,6 +1,6 @@ -{path, version, sha256}: +{ path, version, sha256 }: -{stdenv, fetchurl, lib, z3, makeWrapper, autoPatchelfHook}: +{ stdenv, fetchurl, lib, z3, makeWrapper, autoPatchelfHook }: let # solc uses dlopen to look for z3 at runtime, and expects to find a library # called libz3.so.4.8 exactly. The z3.lib provided by nixpkgs only has a @@ -27,9 +27,10 @@ stdenv.mkDerivation rec { inherit version; platform = - if lib.strings.hasPrefix "solc-linux-amd64" "${path}" - then "linux-amd64" - else "macosx-amd64"; + if lib.strings.hasPrefix "solc-linux-amd64" "${path}" then + "linux-amd64" + else + "macosx-amd64"; dontUnpack = true; dontConfigure = true; @@ -40,12 +41,12 @@ stdenv.mkDerivation rec { sha256 = "${sha256}"; }; - nativeBuildInputs = [ autoPatchelfHook makeWrapper ]; + nativeBuildInputs = [ makeWrapper ] ++ lib.optionals stdenv.isLinux [ autoPatchelfHook ]; - postFixup = if (platform == "linux-amd64") then '' - wrapProgram $out/bin/solc-${version} \ - --prefix LD_LIBRARY_PATH : ${lib.makeLibraryPath [ z3-exact ]} - '' else ""; + postFixup = lib.optionals (platform == "linux-amd64") '' + wrapProgram $out/bin/solc-${version} \ + --prefix LD_LIBRARY_PATH : ${lib.makeLibraryPath [ z3-exact ]} + ''; installPhase = '' mkdir -p $out/bin diff --git a/nix/solidity-package.sh b/nix/solidity-package.sh index f2d71354a..7819f7a3b 100755 --- a/nix/solidity-package.sh +++ b/nix/solidity-package.sh @@ -24,7 +24,7 @@ fi if [[ $flatten == 1 && ! $x =~ \.t(\.[a-z0-9]+)*\.sol$ ]]; then flat_file="$DAPP_OUT/$dir/${x##*/}.flat" (set -x; solc $REMAPPINGS --allow-paths $DAPP_SRC $solcFlags $jsonopts "$x" >"$json_file") - (set -x; hevm flatten --source-file "$x" --json-file "$json_file" >"$flat_file") + (set -x; eth-utils flatten --source-file "$x" --json-file "$json_file" >"$flat_file") x="$flat_file" fi diff --git a/overlay.nix b/overlay.nix index 5dae1e15e..035c964e6 100644 --- a/overlay.nix +++ b/overlay.nix @@ -38,10 +38,6 @@ in rec { # Here we can make e.g. integration tests for Dappsys. dapp-tests = import ./src/dapp-tests { inherit (self) pkgs; }; - # These are tests that verify the correctness of hevm symbolic using various - # external test suites (e.g. the solc tests) - hevm-tests = import ./nix/hevm-tests { pkgs = self.pkgs; }; - bashScript = { name, version ? "0", deps ? [], text, check ? true } : self.pkgs.writeTextFile { name = "${name}-${version}"; @@ -79,7 +75,10 @@ in rec { fetchSolcVersions { owner = "dapphub"; attr = "unreleased_" + super.system; } ); - solc = self.pkgs.runCommand "solc" { } "mkdir -p $out/bin; ln -s ${solc-static-versions.solc_0_8_6}/bin/solc-0.8.6 $out/bin/solc"; + solc = self.pkgs.runCommand "solc" { } '' + mkdir -p $out/bin + ln -s ${solc-static-versions.solc_0_8_6}/bin/solc-0.8.6 $out/bin/solc + ''; solc-static-versions = let @@ -93,11 +92,7 @@ in rec { in builtins.mapAttrs make-solc-drv (builtins.getAttr super.system (import ./nix/solc-static-versions.nix)); - # uses solc, z3 and cvc4 from nix - hevm = self.pkgs.haskell.lib.justStaticExecutables self.haskellPackages.hevm; - - # uses solc, z3 and cvc4 from PATH - hevmUnwrapped = self.pkgs.haskell.lib.justStaticExecutables self.unwrappedHaskellPackages.hevm; + eth-utils = self.pkgs.haskell.lib.justStaticExecutables self.haskellPackages.eth-utils; libff = self.callPackage (import ./nix/libff.nix) {}; @@ -110,15 +105,21 @@ in rec { jshon = self.jays; seth = self.callPackage (import ./src/seth) {}; - dapp = self.callPackage (import ./src/dapp) {}; + dapp = self.callPackage (import ./src/dapp) { geth = go-ethereum-unlimited; }; ethsign = (self.callPackage (import ./src/ethsign) {}); token = self.callPackage (import ./src/token) {}; + # Needed for --nix-run subcommands to work, + # see `nix help run` for more info. + go-ethereum = super.go-ethereum.overrideAttrs (geth: { + meta = geth.meta // { mainProgram = "geth"; }; + }); + # We use this to run private testnets without # the pesky transaction size limit. - go-ethereum-unlimited = (self.callPackage (import ./nix/geth.nix) {}).overrideAttrs (geth: rec { + go-ethereum-unlimited = super.go-ethereum.overrideAttrs (geth: { name = "${geth.pname}-unlimited-${geth.version}"; preConfigure = '' # Huge transaction calldata @@ -133,7 +134,12 @@ in rec { substituteInPlace core/genesis.go --replace \ 'GasLimit: 11500000,' \ 'GasLimit: 0xffffffffffffffff,' + + substituteInPlace params/version.go --replace stable unlimited ''; + # Needed for --nix-run subcommands to work, + # see `nix help run` for more info. + meta = geth.meta // { mainProgram = "geth"; }; }); qrtx = self.bashScript { diff --git a/release.nix b/release.nix index c032f5a43..38e304440 100644 --- a/release.nix +++ b/release.nix @@ -5,32 +5,8 @@ let linux = system "x86_64-linux"; darwin = system "x86_64-darwin"; - ethereum-test-suite = x: x.fetchFromGitHub { - owner = "ethereum"; - repo = "tests"; - rev = "e20d7f39aae1e33394ae6b94590d15083e224fa5"; - sha256 = "1i68k3b8sxawbm65mwph8d5ld9jdjh08c6hln0vygjgwmd0j4n30"; - }; - - # run all General State Tests, skipping performance heavy tests and the ones missing - # postState. - hevmCompliance = x: x.runCommand "hevm-compliance" {} '' - mkdir "$out" - export PATH=${x.pkgs.hevm}/bin:${x.pkgs.jq}/bin:$PATH - ${x.pkgs.hevm}/bin/hevm compliance \ - --tests ${ethereum-test-suite x} \ - --skip "(Create2Recursive|Create1000|recursiveCreateReturn|underflowTest|walletRemoveOwnerRemovePending|Return5000|randomStatetest177|loopExp|loopMul|FirstByte)" \ - --timeout 20 \ - --html > $out/index.html - # Disable obsolete VMTests - gas expectations broken by Istanbul - # ${x.pkgs.hevm}/bin/hevm compliance \ - # --tests ${ethereum-test-suite x} \ - # --group "VM" - ''; - # These packages should always work and be available in the binary cache. stable = dist: with dist.pkgs; { - inherit hevm; inherit dapp; inherit ethsign; inherit go-ethereum-unlimited; @@ -42,8 +18,6 @@ let inherit solc-versions; inherit dapp-tests; - inherit hevm-tests; - hevm-compliance = hevmCompliance dist; }; in { diff --git a/src/dapp-tests/Makefile b/src/dapp-tests/Makefile index 5dce7df31..64c88a7b4 100644 --- a/src/dapp-tests/Makefile +++ b/src/dapp-tests/Makefile @@ -1,9 +1,7 @@ test: - pytest --hypothesis-show-statistics integration/diff-fuzz.py bash_unit integration/tests.sh ci: - pytest --hypothesis-show-statistics integration/diff-fuzz.py - FUZZ_RUNS=10000 TESTNET_SLEEP=90 bash_unit integration/tests.sh + FUZZ_RUNS=10000 TESTNET_SLEEP=90 bash_unit -r -f tap integration/tests.sh .PHONY: test diff --git a/src/dapp-tests/integration/contracts/AB.sol b/src/dapp-tests/integration/contracts/AB.sol index 48dfb83f4..8817cb390 100644 --- a/src/dapp-tests/integration/contracts/AB.sol +++ b/src/dapp-tests/integration/contracts/AB.sol @@ -1,3 +1,4 @@ +// SPDX-License-Identifier: AGPL-3.0-only pragma solidity >=0.8; contract A { diff --git a/src/dapp-tests/integration/contracts/factor.sol b/src/dapp-tests/integration/contracts/factor.sol index c906a3c7f..7d56e14c6 100644 --- a/src/dapp-tests/integration/contracts/factor.sol +++ b/src/dapp-tests/integration/contracts/factor.sol @@ -1,3 +1,4 @@ +// SPDX-License-Identifier: AGPL-3.0-only pragma solidity >=0.5.15; contract A { function factor(uint x, uint y) public pure { diff --git a/src/dapp-tests/integration/contracts/stateful.sol b/src/dapp-tests/integration/contracts/stateful.sol index 319a8a0f5..fe453483a 100644 --- a/src/dapp-tests/integration/contracts/stateful.sol +++ b/src/dapp-tests/integration/contracts/stateful.sol @@ -1,3 +1,4 @@ +// SPDX-License-Identifier: AGPL-3.0-only contract A { uint x; diff --git a/src/dapp-tests/integration/diff-fuzz.py b/src/dapp-tests/integration/diff-fuzz.py deleted file mode 100644 index d784b69f8..000000000 --- a/src/dapp-tests/integration/diff-fuzz.py +++ /dev/null @@ -1,82 +0,0 @@ -import json -import os - -from hypothesis import given, example, settings, note, target, Phase -from hypothesis.strategies import binary - - - -@settings( - deadline=2000, - phases=[Phase.explicit, Phase.reuse] -) -@given(binary(min_size=1)) -# these are meant without the prefix -@example(bytes.fromhex('60016000036000f3')) -@example(bytes.fromhex('65f3b2bd95ccaa4520ee607eb0825f')) -@example(bytes.fromhex('6101')) -@example(bytes.fromhex('32')) -@example(bytes.fromhex('04')) -@example(bytes.fromhex('33')) -@example(bytes.fromhex('30')) -@example(bytes.fromhex('45')) -@example(bytes.fromhex('46')) -@example(bytes.fromhex('4151')) -# @example(bytes.fromhex('303b3b')) (geth thinks `this` is cold, hevm disagrees) -@example(bytes.fromhex('6219000151')) -@example(bytes.fromhex('600134f3')) -@example(bytes.fromhex('600141fd')) -@example(bytes.fromhex('2d010101')) - -# This example does not actually work right now because -# hevm and geth have a different interpretation of what -# happens when an empty contract is called: -# hevm visits the contract with an instant STOP -# while geth simply skips the call entirely and moves on -# to the next opcode in the calling contract. - -#@example(bytes.fromhex('60006000601260136014601560166018f4')) - -def test_compare_geth_hevm(b): - code = b.hex() - note("code that caused failure: ") - note(code) - # prepopulate the stack a bit - x = os.system('evm --code ' + code + ' --gas 0xffffffffffffffff --json --receiver 0xacab --nomemory --prestate ./genesis.json run > gethout') - y = os.system('hevm exec --code ' + code + ' --gas 0xffffffffffffffff --chainid 0x539 --gaslimit 0xfffffffff --jsontrace --origin 0x73656e646572 --caller 0x73656e646572 > hevmout') - assert x == y - gethlines = open('gethout').read().split('\n') - hevmlines = open('hevmout').read().split('\n') - target(float(len(gethlines))) - for i in range(len(hevmlines) - 3): - gethline = gethlines[i] - hevmline = hevmlines[i] - hjson = json.loads(hevmline) - gjson = json.loads(gethline) - ## printed when diverging - note('') - note('--- STEP ----') - note('geth thinks that') - note(gethline) - note('while hevm believes') - note(hevmline) - note('') - - assert hjson['pc'] == gjson['pc'] - assert hjson['stack'] == gjson['stack'] - # we can't compare memsize for now because geth - # measures memory and memsize after the instruction, - # as opposed to all other fields... - # assert hjson['memSize'] == gjson['memSize'] - assert hjson['gas'] == gjson['gas'] - gethres = json.loads(gethlines[len(gethlines) - 2]) - hevmres = json.loads(hevmlines[len(hevmlines) - 2]) - note('--- OUTPUT ----') - note('geth thinks that') - note(gethres) - note('while hevm believes') - note(hevmres) - assert gethres['output'] == hevmres['output'] - assert gethres['gasUsed'] == hevmres['gasUsed'] - -test_compare_geth_hevm() diff --git a/src/dapp-tests/integration/tests.sh b/src/dapp-tests/integration/tests.sh index 9023d9e4f..76d6c8faa 100755 --- a/src/dapp-tests/integration/tests.sh +++ b/src/dapp-tests/integration/tests.sh @@ -190,16 +190,16 @@ test_hevm_symbolic() { solc --bin-runtime -o . --overwrite "$CONTRACTS/factor.sol" # should find counterexample - hevm symbolic --code "$( /dev/null || fail solc --bin-runtime -o . --overwrite "$CONTRACTS/token.sol" - # This one explores all paths (cvc4 is better at this) - hevm symbolic --code "$( config.json + + # build with custom json + DAPP_STANDARD_JSON="config.json" dapp --use solc:"0.5.15" build + assert "[[ -f out/dapp.sol.json ]]" +} + +test_seth_use() { + # init custom json + dapp mk-standard-json > config.json + + # build with custom json + DAPP_STANDARD_JSON="config.json" dapp --use solc:"0.5.15" build + assert "[[ -f out/dapp.sol.json ]]" +} + +test_dapp_nix_run_geth_version() { + dapp --nix-run go-ethereum version +} + +test_dapp_nix_run_solc_version() { + VERSION=$(dapp --nix-run "solc-versions.solc_0_5_12" --version | tail -1 | cut -d: -f2 | cut -d+ -f1) + + assert_equals "$VERSION" " 0.5.12" +} + test_gas_snapshots() { tmp=$(mktemp -d) @@ -263,7 +291,9 @@ test_nonce_1() { assert_equals 1 "$(seth nonce "$account")" } -test_block_1() { +# FIXME: another flaky test, see +# https://github.com/dapphub/dapptools/actions/runs/4697496702/jobs/8328631285 +todo_block_1() { local account account=$(fresh_account) @@ -628,7 +658,8 @@ test_to_fix4() { } # SETH RUN-TX TESTS -test_run_tx_source_fetching() { +# currently broken on the hevm side: https://github.com/ethereum/hevm/issues/243 +todo_run_tx_source_fetching() { export ETH_RPC_URL=$ARCHIVE_NODE_URL local out err out=$(mktemp) diff --git a/src/dapp/CHANGELOG.md b/src/dapp/CHANGELOG.md index 8d53f4d5e..c76d5bca0 100644 --- a/src/dapp/CHANGELOG.md +++ b/src/dapp/CHANGELOG.md @@ -10,6 +10,15 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Support for compilation pipeline going through the Yul intermediate representation +- Support for installing and running with [experimental nix commands](https://nixos.org/manual/nix/stable/command-ref/experimental-commands.html) + +### Fixed + +- `dapp --nix-run` invocations + +### Changed + +- Switch SMT solver from cvc4 to cvc5 ## [0.35.0] - 2021-11-12 diff --git a/src/dapp/README.md b/src/dapp/README.md index 375e7855a..e527abb02 100644 --- a/src/dapp/README.md +++ b/src/dapp/README.md @@ -326,7 +326,7 @@ variables](../hevm/README.md#environment-variables). | `DAPP_TEST_DEPTH` | `20` | Number of transactions to sequence per invariant cycle | | `DAPP_TEST_SMTTIMEOUT` | `60000` | Timeout passed to the smt solver for symbolic tests (in ms, and per smt query) | | `DAPP_TEST_MAX_ITERATIONS` | n/a | The number of times hevm will revisit a particular branching point when symbolically executing | -| `DAPP_TEST_SOLVER` | `z3` | Solver to use for symbolic execution (`cvc4` or `z3`) | +| `DAPP_TEST_SOLVER` | `z3` | Solver to use for symbolic execution (`cvc5` or `z3`) | | `DAPP_TEST_MATCH` | n/a | Regex used to determine test methods to run | | `DAPP_TEST_COV_MATCH` | n/a | Regex used to determine which files to print coverage reports for. Prints all imported files by default (excluding tests and libs). | | `DAPP_TEST_REPLAY` | n/a | Calldata for a specific property test case to replay in the debugger | @@ -447,7 +447,7 @@ You can override this with the `DAPP_REMAPPINGS` environment variable. SMT options: --smttimeout timeout passed to the smt solver in ms (default 60000) - --solver name of the smt solver to use (either "z3" or "cvc4") + --solver name of the smt solver to use (either "z3" or "cvc5") --max-iterations number of times we may revisit a particular branching point during symbolic execution dapp tests are written in Solidity using the `ds-test` module. To install it, run diff --git a/src/dapp/default.nix b/src/dapp/default.nix index ea6d3eae9..4ff143303 100644 --- a/src/dapp/default.nix +++ b/src/dapp/default.nix @@ -1,32 +1,70 @@ -{ lib, stdenv, fetchFromGitHub, makeWrapper, glibcLocales -, coreutils, git, gnused, gnumake, hevm, jshon, jq, nix -, nodejs, perl, python3, seth, shellcheck, solc, tre, dapptoolsSrc }: +{ lib +, stdenv +, fetchFromGitHub +, makeWrapper +, glibcLocales +, coreutils +, geth +, git +, gnugrep +, gnused +, gnumake +, hevm +, jshon +, jq +, nix +, nodejs +, perl +, python3 +, seth +, shellcheck +, solc +, tre +, dapptoolsSrc +, eth-utils +}: stdenv.mkDerivation rec { name = "dapp-${version}"; version = "0.35.0"; src = ./.; - nativeBuildInputs = [makeWrapper shellcheck coreutils nodejs python3]; + nativeBuildInputs = [ makeWrapper shellcheck coreutils nodejs python3 ]; buildPhase = "true"; doCheck = true; checkPhase = "make test"; - makeFlags = ["prefix=$(out)"]; + makeFlags = [ "prefix=$(out)" ]; postInstall = let path = lib.makeBinPath [ - coreutils git gnused gnumake hevm jshon jq nix nodejs perl seth solc tre python3 + coreutils + eth-utils + geth + git + gnugrep + gnumake + gnused + hevm + jq + jshon + nix + nodejs + perl + python3 + seth + solc + tre ]; in - '' + '' wrapProgram "$out/bin/dapp" \ --prefix PATH : ${path} \ --set DAPPTOOLS ${dapptoolsSrc} \ ${lib.optionalString (glibcLocales != null) '' --set LOCALE_ARCHIVE ${glibcLocales}/lib/locale/locale-archive ''} - ''; + ''; # the patching of python shebangs is needed by the python invocations in # src/dapp-tests/integration/tests.sh. @@ -39,7 +77,7 @@ stdenv.mkDerivation rec { meta = { description = "Simple tool for creating Ethereum-based dapps"; homepage = https://github.com/dapphub/dapptools/src/dapp/; - maintainers = [lib.maintainers.dbrock]; + maintainers = [ lib.maintainers.dbrock ]; license = lib.licenses.gpl3; inherit version; }; diff --git a/src/dapp/libexec/dapp/dapp b/src/dapp/libexec/dapp/dapp index c8021135b..2a332fe59 100755 --- a/src/dapp/libexec/dapp/dapp +++ b/src/dapp/libexec/dapp/dapp @@ -31,7 +31,7 @@ ### ### SMT options: ### smttimeout= timeout passed to the smt solver in ms (default 60000) -### solver= name of the smt solver to use (either 'z3' or 'cvc4') +### solver= name of the smt solver to use (either 'z3' or 'cvc5') ### max-iterations= number of times we may revisit a particular branching point ### smtdebug print the SMT queries produced by hevm ### @@ -80,7 +80,7 @@ rpc-block= block number (latest if not specified) SMT options: smttimeout= timeout passed to the smt solver in ms (default 60000) -solver= name of the smt solver to use (either 'z3' or 'cvc4') +solver= name of the smt solver to use (either 'z3' or 'cvc5') max-iterations= number of times we may revisit a particular branching point smtdebug print the SMT queries produced by hevm diff --git a/src/dapp/libexec/dapp/dapp---nix-run b/src/dapp/libexec/dapp/dapp---nix-run index 1758fa7c9..87b028d82 100755 --- a/src/dapp/libexec/dapp/dapp---nix-run +++ b/src/dapp/libexec/dapp/dapp---nix-run @@ -1,7 +1,7 @@ #!/usr/bin/env bash # Usage: dapp --nix-run PKG COMMAND... # Example: -# $ dapp --nix-run go-ethereum geth --version +# $ dapp --nix-run go-ethereum version # # Runs a command with the binaries from a named Nix package in PATH. @@ -16,4 +16,4 @@ have() { command -v "$1" >/dev/null; } expr="$1"; shift -nix run "(with import $DAPPTOOLS {}; $expr)" -c "$@" +nix run --impure --expr "with import $DAPPTOOLS {}; $expr" out -- "$@" diff --git a/src/dapp/libexec/dapp/dapp---testnet-launch b/src/dapp/libexec/dapp/dapp---testnet-launch deleted file mode 100755 index 8a7ec630f..000000000 --- a/src/dapp/libexec/dapp/dapp---testnet-launch +++ /dev/null @@ -1,113 +0,0 @@ -#!/usr/bin/env bash -# shellcheck disable=SC2261 -set -e - -DAPP_TESTNET_RPC_PORT=${DAPP_TESTNET_RPC_PORT-8545} -DAPP_TESTNET_RPC_ADDRESS=${DAPP_TESTNET_RPC_ADDRESS-127.0.0.1} -DAPP_TESTNET_PERIOD=${DAPP_TESTNET_PERIOD-0} -DAPP_TESTNET_CHAINID=${DAPP_TESTNET_CHAINID-99} -DAPP_TESTNET_ACCOUNTS=${DAPP_TESTNET_ACCOUNTS-0} -DAPP_TESTNET_gethdir=${DAPP_TESTNET_gethdir-$HOME/.dapp/testnet} - -chaindir=$DAPP_TESTNET_gethdir/$DAPP_TESTNET_RPC_PORT - -if [[ $DAPP_TESTNET_LOAD ]]; then - mkdir -p "$chaindir" - cp -r "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_LOAD"/{keystore,config} "$chaindir" - geth >/dev/null 2>&1 --datadir "$chaindir" init "$chaindir/config/genesis.json" - geth >/dev/null 2>&1 --datadir "$chaindir" import "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_LOAD/backup" - keys=$(jq <"$chaindir/config/genesis.json" -r '.alloc | keys | join(" ")') - IFS=" " read -r -a address <<< "$keys" - DAPP_TESTNET_CHAINID=$(jq <"$chaindir/config/genesis.json" -r ".config.chainId") -else - while true; do - if [[ ! -d "$DAPP_TESTNET_gethdir/$DAPP_TESTNET_CHAINID" ]]; then break; fi - DAPP_TESTNET_CHAINID=$((DAPP_TESTNET_CHAINID + 1)) - done - - mkdir -p "$chaindir/config" - for i in $(seq 0 "$DAPP_TESTNET_ACCOUNTS"); do - address+=( "$( - geth 2>/dev/null account new --datadir "$chaindir" --password=<(exit) 2>/dev/null \ - | grep -o -E "0x[A-Fa-f0-9]*" )" ) - balance+=(-n {} -s "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" -i balance \ - -i "${address[i]}") - done - jshon >"$chaindir/config/genesis.json" \ - -n {} \ - -n {} \ - -n "$DAPP_TESTNET_CHAINID" -i chainId \ - -n 0 -i homesteadBlock \ - -n 0 -i eip150Block \ - -n 0 -i eip155Block \ - -n 0 -i eip158Block \ - -n 0 -i eip160Block \ - -n 0 -i byzantiumBlock \ - -n 0 -i constantinopleBlock \ - -n 0 -i petersburgBlock \ - -n 0 -i istanbulBlock \ - -n 0 -i berlinBlock \ - -n 0 -i londonBlock \ - -n {} -n "$DAPP_TESTNET_PERIOD" -i period -n 3000 -i epoch -i clique \ - -i config \ - -s 0x1 -i difficulty \ - -s 0xffffffffffffffff -i gaslimit \ - -s "0x3132333400000000000000000000000000000000000000000000000000000000""${address[0]#0x}""0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" -i extraData \ - -n {} \ - "${balance[@]}" \ - -i alloc - geth 2>/dev/null --datadir "$chaindir" init "$chaindir/config/genesis.json" -fi - -export ETH_RPC_URL=http://$DAPP_TESTNET_RPC_ADDRESS:$DAPP_TESTNET_RPC_PORT - -port=$((DAPP_TESTNET_RPC_PORT + 30000)) - -echo >&2 "dapp-testnet: RPC URL: $ETH_RPC_URL" -echo >&2 "dapp-testnet: TCP port: $port" -echo >&2 "dapp-testnet: Chain ID: $DAPP_TESTNET_CHAINID" -echo >&2 "dapp-testnet: Database: $chaindir" -echo >&2 "dapp-testnet: Geth log: $chaindir/geth.log" - -printf "%s\n" "${address[@]}" > "$chaindir/config/account" -echo "$ETH_RPC_URL" > "$chaindir/config/rpc-url" -echo "$port" > "$chaindir/config/node-port" - -set +m -geth \ - 2> >(tee "$chaindir/geth.log" | grep --line-buffered Success | sed 's/^/geth: /' >&2) \ - --datadir "$chaindir" --networkid "$DAPP_TESTNET_CHAINID" --port="$port" \ - --mine --miner.threads=1 --allow-insecure-unlock \ - --rpc --rpcapi "web3,eth,net,debug,personal" --rpccorsdomain '*' --nodiscover \ - --rpcaddr="$DAPP_TESTNET_RPC_ADDRESS" --rpcport="$DAPP_TESTNET_RPC_PORT" --unlock="$(IFS=,; echo "${address[*]}")" --password=<(exit) & - -gethpid=$! - -clean() { - ( set -x; kill -INT $gethpid; wait ) - if [[ $DAPP_TESTNET_SAVE ]]; then - echo >&2 "dapp-testnet: saving $DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" - mkdir -p "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" - cp -r "$chaindir/keystore" "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" - cp -r "$chaindir/config" "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" - geth >/dev/null 2>&1 --datadir "$chaindir" \ - export "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE/backup" - fi - ( set -x; rm -rf "$chaindir" ) -} -trap clean EXIT - -until curl -s "$ETH_RPC_URL"; do sleep 1; done - -ETH_FROM=$(seth --rpc-url="$ETH_RPC_URL" rpc eth_coinbase) -export ETH_FROM -export ETH_KEYSTORE=$chaindir/keystore -export ETH_PASSWORD=/dev/null -printf 'dapp-testnet: Account: %s (default)\n' "${address[0]}" >&2 -[[ "${#address[@]}" -gt 1 ]] && printf 'dapp-testnet: Account: %s\n' "${address[@]:1}" >&2 - -if [[ $1 ]]; then - "$@" -else - while true; do sleep 3600; done -fi diff --git a/src/dapp/libexec/dapp/dapp---use b/src/dapp/libexec/dapp/dapp---use index 92fe8da99..9dad6291a 100755 --- a/src/dapp/libexec/dapp/dapp---use +++ b/src/dapp/libexec/dapp/dapp---use @@ -16,6 +16,11 @@ query() { nix-env -q --installed --out-path --no-name "$1" 2>/dev/null } +# Profiles created with the experimental nix commands are incompatible with nix-env ones, so we need to handle them separately. +query_nix3() { + nix profile list 2>/dev/null | grep "$1" +} + shopt -s extglob case $1 in # package spec e.g. solc:0.4.12 @@ -23,8 +28,14 @@ case $1 in solc="solc-${1#solc:}" if store_path=$(query "solc-${1#solc:}"); then bin="$store_path/bin/solc" + elif output=$(query_nix3 "solc-${1#solc:}"); then + store_path=$(echo "$output" | cut -d " " -f 4) + bin="$store_path/bin/solc" elif store_path=$(query "solc-static-${1#solc:}"); then bin="$store_path/bin/$solc" + elif output=$(query_nix3 "solc-static-${1#solc:}"); then + store_path=$(echo "$output" | cut -d " " -f 4) + bin="$store_path/bin/$solc" else bin="" fi @@ -48,15 +59,10 @@ shift [[ "$#" -gt 0 ]] || usage if [[ -z "$bin" ]]; then - echo >&2 "${0##*/}: Could not find ${solc} in your path or nix store." - echo >&2 "Temporarily installing ${solc}..." - echo >&2 "Tip: run \`nix-env -f https://github.com/dapphub/dapptools/archive/master.tar.gz -iA solc-static-versions.${solc//[-.]/_}\` for a lasting installation of this version." - dapp --nix-run "dapp.override {solc = pkgs.runCommand \"solc\" { } \"mkdir -p \$out/bin; ln -s \${solc-static-versions.${solc//[-.]/_}}/bin/${solc} \$out/bin/solc\";}" dapp "$@" - - exit 0 + dapp --nix-run "dapp.override {solc = pkgs.runCommand \"solc\" { } \"mkdir -p \$out/bin; ln -s \${solc-static-versions.${solc//[-.]/_}}/bin/${solc} \$out/bin/solc\";}" "$@" else set -e SOLCBIN="$(realpath -e "${bin}")" -fi -DAPP_SOLC="$SOLCBIN" dapp "$@" + DAPP_SOLC="$SOLCBIN" dapp "$@" +fi diff --git a/src/dapp/libexec/dapp/dapp-address b/src/dapp/libexec/dapp/dapp-address index 65a98436a..b6b78e8f8 100755 --- a/src/dapp/libexec/dapp/dapp-address +++ b/src/dapp/libexec/dapp/dapp-address @@ -1,4 +1,5 @@ #!/usr/bin/env bash +# shellcheck disable=SC2309 ### dapp-address -- determine address of newly generated contract ### Usage: dapp address set -e diff --git a/src/dapp/libexec/dapp/dapp-test b/src/dapp/libexec/dapp/dapp-test index f7ddebd54..210d8e89c 100755 --- a/src/dapp/libexec/dapp/dapp-test +++ b/src/dapp/libexec/dapp/dapp-test @@ -18,7 +18,7 @@ ### ### SMT options: ### --smttimeout timeout passed to the smt solver in ms (default 600000) -### --solver name of the smt solver to use (either "z3" or "cvc4") +### --solver name of the smt solver to use (either "z3" or "cvc5") ### --max-iterations number of times we may revisit a particular branching point set -e have() { command -v "$1" >/dev/null; } diff --git a/src/dapp/libexec/dapp/dapp-testnet b/src/dapp/libexec/dapp/dapp-testnet index f12629e69..6f15d6e9c 100755 --- a/src/dapp/libexec/dapp/dapp-testnet +++ b/src/dapp/libexec/dapp/dapp-testnet @@ -1,4 +1,116 @@ #!/usr/bin/env bash ### dapp-testnet -- launch a testnet ### Usage: dapp testnet [] -dapp --nix-run go-ethereum-unlimited dapp --testnet-launch "$@" + +# shellcheck disable=SC2261 +set -e + +DAPP_TESTNET_RPC_PORT=${DAPP_TESTNET_RPC_PORT-8545} +DAPP_TESTNET_RPC_ADDRESS=${DAPP_TESTNET_RPC_ADDRESS-127.0.0.1} +DAPP_TESTNET_PERIOD=${DAPP_TESTNET_PERIOD-0} +DAPP_TESTNET_CHAINID=${DAPP_TESTNET_CHAINID-99} +DAPP_TESTNET_ACCOUNTS=${DAPP_TESTNET_ACCOUNTS-0} +DAPP_TESTNET_gethdir=${DAPP_TESTNET_gethdir-$HOME/.dapp/testnet} + +chaindir=$DAPP_TESTNET_gethdir/$DAPP_TESTNET_RPC_PORT + +if [[ $DAPP_TESTNET_LOAD ]]; then + mkdir -p "$chaindir" + cp -r "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_LOAD"/{keystore,config} "$chaindir" + geth >/dev/null 2>&1 --datadir "$chaindir" init "$chaindir/config/genesis.json" + geth >/dev/null 2>&1 --datadir "$chaindir" import "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_LOAD/backup" + keys=$(jq <"$chaindir/config/genesis.json" -r '.alloc | keys | join(" ")') + IFS=" " read -r -a address <<< "$keys" + DAPP_TESTNET_CHAINID=$(jq <"$chaindir/config/genesis.json" -r ".config.chainId") +else + while true; do + if [[ ! -d "$DAPP_TESTNET_gethdir/$DAPP_TESTNET_CHAINID" ]]; then break; fi + DAPP_TESTNET_CHAINID=$((DAPP_TESTNET_CHAINID + 1)) + done + + mkdir -p "$chaindir/config" + for i in $(seq 0 "$DAPP_TESTNET_ACCOUNTS"); do + address+=( "$( + geth 2>/dev/null account new --datadir "$chaindir" --password=<(exit) 2>/dev/null \ + | grep -o -E "0x[A-Fa-f0-9]*" )" ) + balance+=(-n {} -s "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" -i balance \ + -i "${address[i]}") + done + jshon >"$chaindir/config/genesis.json" \ + -n {} \ + -n {} \ + -n "$DAPP_TESTNET_CHAINID" -i chainId \ + -n 0 -i homesteadBlock \ + -n 0 -i eip150Block \ + -n 0 -i eip155Block \ + -n 0 -i eip158Block \ + -n 0 -i eip160Block \ + -n 0 -i byzantiumBlock \ + -n 0 -i constantinopleBlock \ + -n 0 -i petersburgBlock \ + -n 0 -i istanbulBlock \ + -n 0 -i berlinBlock \ + -n 0 -i londonBlock \ + -n {} -n "$DAPP_TESTNET_PERIOD" -i period -n 3000 -i epoch -i clique \ + -i config \ + -s 0x1 -i difficulty \ + -s 0xffffffffffffffff -i gaslimit \ + -s "0x3132333400000000000000000000000000000000000000000000000000000000""${address[0]#0x}""0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" -i extraData \ + -n {} \ + "${balance[@]}" \ + -i alloc + geth 2>/dev/null --datadir "$chaindir" init "$chaindir/config/genesis.json" +fi + +export ETH_RPC_URL=http://$DAPP_TESTNET_RPC_ADDRESS:$DAPP_TESTNET_RPC_PORT + +port=$((DAPP_TESTNET_RPC_PORT + 30000)) + +echo >&2 "dapp-testnet: RPC URL: $ETH_RPC_URL" +echo >&2 "dapp-testnet: TCP port: $port" +echo >&2 "dapp-testnet: Chain ID: $DAPP_TESTNET_CHAINID" +echo >&2 "dapp-testnet: Database: $chaindir" +echo >&2 "dapp-testnet: Geth log: $chaindir/geth.log" + +printf "%s\n" "${address[@]}" > "$chaindir/config/account" +echo "$ETH_RPC_URL" > "$chaindir/config/rpc-url" +echo "$port" > "$chaindir/config/node-port" + +set +m +geth \ + 2> >(tee "$chaindir/geth.log" | grep --line-buffered Success | sed 's/^/geth: /' >&2) \ + --datadir "$chaindir" --networkid "$DAPP_TESTNET_CHAINID" --port="$port" \ + --mine --miner.threads=1 --allow-insecure-unlock \ + --http --http.api "web3,eth,net,debug,personal" --http.corsdomain '*' --nodiscover \ + --http.addr="$DAPP_TESTNET_RPC_ADDRESS" --http.port="$DAPP_TESTNET_RPC_PORT" --unlock="$(IFS=,; echo "${address[*]}")" --password=<(exit) & + +gethpid=$! + +clean() { + ( set -x; kill -INT $gethpid; wait ) + if [[ $DAPP_TESTNET_SAVE ]]; then + echo >&2 "dapp-testnet: saving $DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" + mkdir -p "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" + cp -r "$chaindir/keystore" "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" + cp -r "$chaindir/config" "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE" + geth >/dev/null 2>&1 --datadir "$chaindir" \ + export "$DAPP_TESTNET_gethdir/snapshots/$DAPP_TESTNET_SAVE/backup" + fi + ( set -x; rm -rf "$chaindir" ) +} +trap clean EXIT + +until curl -s "$ETH_RPC_URL"; do sleep 1; done + +ETH_FROM=$(seth --rpc-url="$ETH_RPC_URL" rpc eth_coinbase) +export ETH_FROM +export ETH_KEYSTORE=$chaindir/keystore +export ETH_PASSWORD=/dev/null +printf 'dapp-testnet: Account: %s (default)\n' "${address[0]}" >&2 +[[ "${#address[@]}" -gt 1 ]] && printf 'dapp-testnet: Account: %s\n' "${address[@]:1}" >&2 + +if [[ $1 ]]; then + "$@" +else + while true; do sleep 3600; done +fi diff --git a/src/dapp/libexec/dapp/dapp-verify-contract b/src/dapp/libexec/dapp/dapp-verify-contract index 3beda7e74..d66d0adf2 100755 --- a/src/dapp/libexec/dapp/dapp-verify-contract +++ b/src/dapp/libexec/dapp/dapp-verify-contract @@ -77,7 +77,7 @@ address=${2?contractaddress} # combined-json has a sourceList field if [[ $(jq .sourceList "$DAPP_JSON") == null ]]; then contract=$(<"$DAPP_JSON" jq -r ".contracts[\"${path/:*/}\"][\"$name\"]") -else +else contract=$(<"$DAPP_JSON" jq -r ".contracts[\"$path\"]") fi meta=$(jshon <<<"$contract" -e metadata -u) @@ -131,7 +131,7 @@ params=( "apikey=$ETHERSCAN_API_KEY" ) -source=$(hevm flatten --source-file "$file" --json-file "$DAPP_JSON" --dapp-root "$DAPP_ROOT") +source=$(eth-utils flatten --source-file "$file" --json-file "$DAPP_JSON" --dapp-root "$DAPP_ROOT") source=$(cat <<. // Verified using https://dapp.tools diff --git a/src/hevm/.dir-locals.el b/src/eth-utils/.dir-locals.el similarity index 100% rename from src/hevm/.dir-locals.el rename to src/eth-utils/.dir-locals.el diff --git a/src/hevm/.gitignore b/src/eth-utils/.gitignore similarity index 100% rename from src/hevm/.gitignore rename to src/eth-utils/.gitignore diff --git a/src/hevm/.hlint.yaml b/src/eth-utils/.hlint.yaml similarity index 100% rename from src/hevm/.hlint.yaml rename to src/eth-utils/.hlint.yaml diff --git a/src/hevm/.travis.yml b/src/eth-utils/.travis.yml similarity index 100% rename from src/hevm/.travis.yml rename to src/eth-utils/.travis.yml diff --git a/src/eth-utils/README.md b/src/eth-utils/README.md new file mode 100644 index 000000000..e6abdb246 --- /dev/null +++ b/src/eth-utils/README.md @@ -0,0 +1,7 @@ +# eth-utils + +This is a small wrapper around hevm that exposes a few useful utilities that are needed in dapp and +seth: + +- flatten: flattens solidity source code +- abiencode: encodes inputs into the solidity ABI spec diff --git a/src/hevm/Setup.hs b/src/eth-utils/Setup.hs similarity index 100% rename from src/hevm/Setup.hs rename to src/eth-utils/Setup.hs diff --git a/src/eth-utils/eth-utils.cabal b/src/eth-utils/eth-utils.cabal new file mode 100644 index 000000000..a84109308 --- /dev/null +++ b/src/eth-utils/eth-utils.cabal @@ -0,0 +1,56 @@ +cabal-version: 3.0 +name: + eth-utils +version: + 0.1.0 +synopsis: + Ethereum related utilities +description: + eth-utils implements the following: + - source code flattening + - abi encoding + - rlp encoding + - solidity metadata stripping +homepage: + https://github.com/dapphub/dapptools +license: + AGPL-3.0-only +author: + Mikael Brockman, Martin Lundfall, dxo +maintainer: + mikael@brockman.se, martin.lundfall@gmail.com, git@d-xo.org +category: + Ethereum +build-type: + Simple +extra-source-files: + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/dapphub/dapptools.git + +executable eth-utils + hs-source-dirs: + src + main-is: + Main.hs + ghc-options: + -Wall -threaded -with-rtsopts=-N -Wno-unticked-promoted-constructors -Wno-orphans + if os(darwin) + extra-libraries: c++ + ld-options: -Wl,-keep_dwarf_unwind + else + extra-libraries: stdc++ + build-depends: + hevm, + aeson, + directory, + lens, + lens-aeson, + vector, + optparse-generic, + bytestring, + containers, + base, + text diff --git a/src/eth-utils/hie.yaml b/src/eth-utils/hie.yaml new file mode 100644 index 000000000..2d7b25dd6 --- /dev/null +++ b/src/eth-utils/hie.yaml @@ -0,0 +1,4 @@ +cradle: + cabal: + - path: "./src" + component: "eth-utils" diff --git a/src/hevm/src/EVM/Flatten.hs b/src/eth-utils/src/Flatten.hs similarity index 100% rename from src/hevm/src/EVM/Flatten.hs rename to src/eth-utils/src/Flatten.hs diff --git a/src/eth-utils/src/Main.hs b/src/eth-utils/src/Main.hs new file mode 100644 index 000000000..f74d3d8bd --- /dev/null +++ b/src/eth-utils/src/Main.hs @@ -0,0 +1,102 @@ +{-# Language DataKinds #-} +{-# Language StandaloneDeriving #-} +{-# Language DeriveAnyClass #-} +{-# Language FlexibleInstances #-} +{-# Language DeriveGeneric #-} +{-# Language GADTs #-} +{-# Language LambdaCase #-} +{-# Language OverloadedStrings #-} +{-# Language TypeOperators #-} +{-# Language RecordWildCards #-} + +module Main where + +import Data.ByteString (ByteString) +import Options.Generic as Options +import Data.Maybe +import Data.List +import Data.Aeson.Lens +import System.Directory +import Control.Lens +import qualified Data.Text as T +import qualified Data.Vector as V + +import EVM.ABI +import EVM.Solidity +import EVM.Types hiding (word) +import EVM.Dapp (dappInfo) + +import qualified EVM.Flatten + +-- This record defines the program's command-line options +-- automatically via the `optparse-generic` package. +data Command w + = Flatten -- Concat all dependencies for a given source file + { sourceFile :: w ::: String "Path to solidity source file e.g. src/contract.sol" + , jsonFile :: w ::: Maybe String "Filename or path to dapp build output (default: out/*.solc.json)" + , dappRoot :: w ::: Maybe String "Path to dapp project root directory (default: . )" + } + | Abiencode + { abi :: w ::: Maybe String "Signature of types to decode / encode" + , arg :: w ::: [String] "Values to encode" + } + + deriving (Options.Generic) + +instance Options.ParseRecord (Command Options.Wrapped) where + parseRecord = + Options.parseRecordWithModifiers Options.lispCaseModifiers + +main :: IO () +main = do + cmd <- Options.unwrapRecord "eth-utils" + let + root = fromMaybe "." (dappRoot cmd) + case cmd of + Abiencode {} -> + print . ByteStringS $ abiencode (abi cmd) (arg cmd) + Flatten {} -> + withCurrentDirectory root $ do + theJson <- findJsonFile (jsonFile cmd) + readSolc theJson >>= + \case + Just (contractMap, cache) -> do + let dapp = dappInfo "." contractMap cache + EVM.Flatten.flatten dapp (T.pack (sourceFile cmd)) + Nothing -> + error ("Failed to read Solidity JSON for `" ++ theJson ++ "'") + +findJsonFile :: Maybe String -> IO String +findJsonFile (Just s) = pure s +findJsonFile Nothing = do + outFiles <- listDirectory "out" + case filter (isSuffixOf ".sol.json") outFiles of + [x] -> pure ("out/" ++ x) + [] -> + error $ concat + [ "No `*.sol.json' file found in `./out'.\n" + , "Maybe you need to run `dapp build'.\n" + , "You can specify a file with `--json-file'." + ] + xs -> + error $ concat + [ "Multiple `*.sol.json' files found in `./out'.\n" + , "Specify one using `--json-file'.\n" + , "Files found: " + , intercalate ", " xs + ] + +parseAbi :: (AsValue s) => s -> (Text, [AbiType]) +parseAbi abijson = + (signature abijson, snd + <$> parseMethodInput + <$> V.toList + (fromMaybe (error "Malformed function abi") (abijson ^? key "inputs" . _Array))) + +abiencode :: (AsValue s) => Maybe s -> [String] -> ByteString +abiencode Nothing _ = error "missing required argument: abi" +abiencode (Just abijson) args = + let (sig', declarations) = parseAbi abijson + in if length declarations == length args + then abiMethod sig' $ AbiTuple . V.fromList $ zipWith makeAbiValue declarations args + else error $ "wrong number of arguments:" <> show (length args) <> ": " <> show args diff --git a/src/ethsign/default.nix b/src/ethsign/default.nix index a15f2df61..f77458035 100644 --- a/src/ethsign/default.nix +++ b/src/ethsign/default.nix @@ -1,16 +1,16 @@ { lib, buildGoModule }: -buildGoModule rec { - name = "ethsign-${version}"; +buildGoModule { + pname = "ethsign"; version = "0.17.1"; src = ./.; - vendorSha256 = "1zbsq1lyqinyzv5x4p1xgkxsyb7y92fbmf44gyaix34xrag5s27m"; - runVend = true; + vendorHash = "sha256-LSnwKW79m70RiVv9INJb8oEzDmouJtiqYLHNBD8KAzY="; + proxyVendor = true; meta = { - homepage = http://github.com/dapphub/dapptools; + homepage = "http://github.com/dapphub/dapptools"; description = "Make raw signed Ethereum transactions"; license = [lib.licenses.agpl3]; }; diff --git a/src/ethsign/go.mod b/src/ethsign/go.mod index 320c37c68..9a4eee57d 100644 --- a/src/ethsign/go.mod +++ b/src/ethsign/go.mod @@ -3,20 +3,7 @@ module github.com/dapphub/ethsign go 1.13 require ( - github.com/OneOfOne/xxhash v1.2.5 // indirect - github.com/aristanetworks/goarista v0.0.0-20170210015632-ea17b1a17847 // indirect - github.com/aws/aws-sdk-go v1.25.48 // indirect - github.com/elastic/gosigar v0.8.1-0.20180330100440-37f05ff46ffa // indirect github.com/ethereum/go-ethereum v1.10.6 - github.com/pborman/uuid v0.0.0-20170112150404-1b00554d8222 // indirect - github.com/robertkrimen/otto v0.0.0-20170205013659-6a77b7cbc37d // indirect - github.com/rs/xhandler v0.0.0-20160618193221-ed27b6fd6521 // indirect - github.com/spaolacci/murmur3 v1.0.1-0.20190317074736-539464a789e9 // indirect - github.com/steakknife/bloomfilter v0.0.0-20180922174646-6819c0d2a570 // indirect - github.com/steakknife/hamming v0.0.0-20180906055917-c99c65617cd3 // indirect - github.com/wsddn/go-ecdh v0.0.0-20161211032359-48726bab9208 // indirect golang.org/x/crypto v0.0.0-20210322153248-0c34fe9e7dc2 - golang.org/x/mobile v0.0.0-20200801112145-973feb4309de // indirect - gopkg.in/sourcemap.v1 v1.0.5 // indirect gopkg.in/urfave/cli.v1 v1.20.0 ) diff --git a/src/ethsign/go.sum b/src/ethsign/go.sum new file mode 100644 index 000000000..df4de2e2b --- /dev/null +++ b/src/ethsign/go.sum @@ -0,0 +1,554 @@ +cloud.google.com/go v0.26.0/go.mod h1:aQUYkXzVsufM+DwF1aE+0xfcU+56JwCaLick0ClmMTw= +cloud.google.com/go v0.34.0/go.mod h1:aQUYkXzVsufM+DwF1aE+0xfcU+56JwCaLick0ClmMTw= +cloud.google.com/go v0.38.0/go.mod h1:990N+gfupTy94rShfmMCWGDn0LpTmnzTp2qbd1dvSRU= +cloud.google.com/go v0.43.0/go.mod h1:BOSR3VbTLkk6FDC/TcffxP4NF/FFBGA5ku+jvKOP7pg= +cloud.google.com/go v0.44.1/go.mod h1:iSa0KzasP4Uvy3f1mN/7PiObzGgflwredwwASm/v6AU= +cloud.google.com/go v0.44.2/go.mod h1:60680Gw3Yr4ikxnPRS/oxxkBccT6SA1yMk63TGekxKY= +cloud.google.com/go v0.45.1/go.mod h1:RpBamKRgapWJb87xiFSdk4g1CME7QZg3uwTez+TSTjc= +cloud.google.com/go v0.46.3/go.mod h1:a6bKKbmY7er1mI7TEI4lsAkts/mkhTSZK8w33B4RAg0= +cloud.google.com/go v0.50.0/go.mod h1:r9sluTvynVuxRIOHXQEHMFffphuXHOMZMycpNR5e6To= +cloud.google.com/go v0.51.0/go.mod h1:hWtGJ6gnXH+KgDv+V0zFGDvpi07n3z8ZNj3T1RW0Gcw= +cloud.google.com/go/bigquery v1.0.1/go.mod h1:i/xbL2UlR5RvWAURpBYZTtm/cXjCha9lbfbpx4poX+o= +cloud.google.com/go/bigquery v1.3.0/go.mod h1:PjpwJnslEMmckchkHFfq+HTD2DmtT67aNFKH1/VBDHE= +cloud.google.com/go/bigtable v1.2.0/go.mod h1:JcVAOl45lrTmQfLj7T6TxyMzIN/3FGGcFm+2xVAli2o= +cloud.google.com/go/datastore v1.0.0/go.mod h1:LXYbyblFSglQ5pkeyhO+Qmw7ukd3C+pD7TKLgZqpHYE= +cloud.google.com/go/pubsub v1.0.1/go.mod h1:R0Gpsv3s54REJCy4fxDixWD93lHJMoZTyQ2kNxGRt3I= +cloud.google.com/go/pubsub v1.1.0/go.mod h1:EwwdRX2sKPjnvnqCa270oGRyludottCI76h+R3AArQw= +cloud.google.com/go/storage v1.0.0/go.mod h1:IhtSnM/ZTZV8YYJWCY8RULGVqBDmpoyjwiyrjsg+URw= +cloud.google.com/go/storage v1.5.0/go.mod h1:tpKbwo567HUNpVclU5sGELwQWBDZ8gh0ZeosJ0Rtdos= +collectd.org v0.3.0/go.mod h1:A/8DzQBkF6abtvrT2j/AU/4tiBgJWYyh0y/oB/4MlWE= +dmitri.shuralyov.com/gpu/mtl v0.0.0-20190408044501-666a987793e9/go.mod h1:H6x//7gZCb22OMCxBHrMx7a5I7Hp++hsVxbQ4BYO7hU= +github.com/Azure/azure-pipeline-go v0.2.1/go.mod h1:UGSo8XybXnIGZ3epmeBw7Jdz+HiUVpqIlpz/HKHylF4= +github.com/Azure/azure-pipeline-go v0.2.2/go.mod h1:4rQ/NZncSvGqNkkOsNpOU1tgoNuIlp9AfUH5G1tvCHc= +github.com/Azure/azure-storage-blob-go v0.7.0/go.mod h1:f9YQKtsG1nMisotuTPpO0tjNuEjKRYAcJU8/ydDI++4= +github.com/Azure/go-autorest/autorest v0.9.0/go.mod h1:xyHB1BMZT0cuDHU7I0+g046+BFDTQ8rEZB0s4Yfa6bI= +github.com/Azure/go-autorest/autorest/adal v0.5.0/go.mod h1:8Z9fGy2MpX0PvDjB1pEgQTmVqjGhiHBW7RJJEciWzS0= +github.com/Azure/go-autorest/autorest/adal v0.8.0/go.mod h1:Z6vX6WXXuyieHAXwMj0S6HY6e6wcHn37qQMBQlvY3lc= +github.com/Azure/go-autorest/autorest/date v0.1.0/go.mod h1:plvfp3oPSKwf2DNjlBjWF/7vwR+cUD/ELuzDCXwHUVA= +github.com/Azure/go-autorest/autorest/date v0.2.0/go.mod h1:vcORJHLJEh643/Ioh9+vPmf1Ij9AEBM5FuBIXLmIy0g= +github.com/Azure/go-autorest/autorest/mocks v0.1.0/go.mod h1:OTyCOPRA2IgIlWxVYxBee2F5Gr4kF2zd2J5cFRaIDN0= +github.com/Azure/go-autorest/autorest/mocks v0.2.0/go.mod h1:OTyCOPRA2IgIlWxVYxBee2F5Gr4kF2zd2J5cFRaIDN0= +github.com/Azure/go-autorest/autorest/mocks v0.3.0/go.mod h1:a8FDP3DYzQ4RYfVAxAN3SVSiiO77gL2j2ronKKP0syM= +github.com/Azure/go-autorest/logger v0.1.0/go.mod h1:oExouG+K6PryycPJfVSxi/koC6LSNgds39diKLz7Vrc= +github.com/Azure/go-autorest/tracing v0.5.0/go.mod h1:r/s2XiOKccPW3HrqB+W0TQzfbtp2fGCgRFtBroKn4Dk= +github.com/BurntSushi/toml v0.3.1/go.mod h1:xHWCNGjB5oqiDr8zfno3MHue2Ht5sIBksp03qcyfWMU= +github.com/BurntSushi/xgb v0.0.0-20160522181843-27f122750802/go.mod h1:IVnqGOEym/WlBOVXweHU+Q+/VP0lqqI8lqeDx9IjBqo= +github.com/DATA-DOG/go-sqlmock v1.3.3/go.mod h1:f/Ixk793poVmq4qj/V1dPUg2JEAKC73Q5eFN3EC/SaM= +github.com/OneOfOne/xxhash v1.2.2/go.mod h1:HSdplMjZKSmBqAxg5vPj2TmRDmfkzw+cTzAElWljhcU= +github.com/StackExchange/wmi v0.0.0-20180116203802-5d049714c4a6 h1:fLjPD/aNc3UIOA6tDi6QXUemppXK3P9BI7mr2hd6gx8= +github.com/StackExchange/wmi v0.0.0-20180116203802-5d049714c4a6/go.mod h1:3eOhrUMpNV+6aFIbp5/iudMxNCF27Vw2OZgy4xEx0Fg= +github.com/VictoriaMetrics/fastcache v1.6.0 h1:C/3Oi3EiBCqufydp1neRZkqcwmEiuRT9c3fqvvgKm5o= +github.com/VictoriaMetrics/fastcache v1.6.0/go.mod h1:0qHz5QP0GMX4pfmMA/zt5RgfNuXJrTP0zS7DqpHGGTw= +github.com/aead/siphash v1.0.1/go.mod h1:Nywa3cDsYNNK3gaciGTWPwHt0wlpNV15vwmswBAUSII= +github.com/ajstarks/svgo v0.0.0-20180226025133-644b8db467af/go.mod h1:K08gAheRH3/J6wwsYMMT4xOr94bZjxIelGM0+d/wbFw= +github.com/alecthomas/template v0.0.0-20160405071501-a0175ee3bccc/go.mod h1:LOuyumcjzFXgccqObfd/Ljyb9UuFJ6TxHnclSeseNhc= +github.com/alecthomas/units v0.0.0-20151022065526-2efee857e7cf/go.mod h1:ybxpYRFXyAe+OPACYpWeL0wqObRcbAqCMya13uyzqw0= +github.com/allegro/bigcache v1.2.1-0.20190218064605-e24eb225f156 h1:eMwmnE/GDgah4HI848JfFxHt+iPb26b4zyfspmqY0/8= +github.com/allegro/bigcache v1.2.1-0.20190218064605-e24eb225f156/go.mod h1:Cb/ax3seSYIx7SuZdm2G2xzfwmv3TPSk2ucNfQESPXM= +github.com/andreyvit/diff v0.0.0-20170406064948-c7f18ee00883/go.mod h1:rCTlJbsFo29Kk6CurOXKm700vrz8f0KW0JNfpkRJY/8= +github.com/apache/arrow/go/arrow v0.0.0-20191024131854-af6fa24be0db/go.mod h1:VTxUBvSJ3s3eHAg65PNgrsn5BtqCRPdmyXh6rAfdxN0= +github.com/aws/aws-sdk-go-v2 v1.2.0/go.mod h1:zEQs02YRBw1DjK0PoJv3ygDYOFTre1ejlJWl8FwAuQo= +github.com/aws/aws-sdk-go-v2/config v1.1.1/go.mod h1:0XsVy9lBI/BCXm+2Tuvt39YmdHwS5unDQmxZOYe8F5Y= +github.com/aws/aws-sdk-go-v2/credentials v1.1.1/go.mod h1:mM2iIjwl7LULWtS6JCACyInboHirisUUdkBPoTHMOUo= +github.com/aws/aws-sdk-go-v2/feature/ec2/imds v1.0.2/go.mod h1:3hGg3PpiEjHnrkrlasTfxFqUsZ2GCk/fMUn4CbKgSkM= +github.com/aws/aws-sdk-go-v2/service/internal/presigned-url v1.0.2/go.mod h1:45MfaXZ0cNbeuT0KQ1XJylq8A6+OpVV2E5kvY/Kq+u8= +github.com/aws/aws-sdk-go-v2/service/route53 v1.1.1/go.mod h1:rLiOUrPLW/Er5kRcQ7NkwbjlijluLsrIbu/iyl35RO4= +github.com/aws/aws-sdk-go-v2/service/sso v1.1.1/go.mod h1:SuZJxklHxLAXgLTc1iFXbEWkXs7QRTQpCLGaKIprQW0= +github.com/aws/aws-sdk-go-v2/service/sts v1.1.1/go.mod h1:Wi0EBZwiz/K44YliU0EKxqTCJGUfYTWXrrBwkq736bM= +github.com/aws/smithy-go v1.1.0/go.mod h1:EzMw8dbp/YJL4A5/sbhGddag+NPT7q084agLbB9LgIw= +github.com/beorn7/perks v0.0.0-20180321164747-3a771d992973/go.mod h1:Dwedo/Wpr24TaqPxmxbtue+5NUziq4I4S80YR8gNf3Q= +github.com/beorn7/perks v1.0.0/go.mod h1:KWe93zE9D1o94FZ5RNwFwVgaQK1VOXiVxmqh+CedLV8= +github.com/bmizerany/pat v0.0.0-20170815010413-6226ea591a40/go.mod h1:8rLXio+WjiTceGBHIoTvn60HIbs7Hm7bcHjyrSqYB9c= +github.com/boltdb/bolt v1.3.1/go.mod h1:clJnj/oiGkjum5o1McbSZDSLxVThjynRyGBgiAx27Ps= +github.com/btcsuite/btcd v0.20.1-beta h1:Ik4hyJqN8Jfyv3S4AGBOmyouMsYE3EdYODkMbQjwPGw= +github.com/btcsuite/btcd v0.20.1-beta/go.mod h1:wVuoA8VJLEcwgqHBwHmzLRazpKxTv13Px/pDuV7OomQ= +github.com/btcsuite/btclog v0.0.0-20170628155309-84c8d2346e9f/go.mod h1:TdznJufoqS23FtqVCzL0ZqgP5MqXbb4fg/WgDys70nA= +github.com/btcsuite/btcutil v0.0.0-20190425235716-9e5f4b9a998d/go.mod h1:+5NJ2+qvTyV9exUAL/rxXi3DcLg2Ts+ymUAY5y4NvMg= +github.com/btcsuite/go-socks v0.0.0-20170105172521-4720035b7bfd/go.mod h1:HHNXQzUsZCxOoE+CPiyCTO6x34Zs86zZUiwtpXoGdtg= +github.com/btcsuite/goleveldb v0.0.0-20160330041536-7834afc9e8cd/go.mod h1:F+uVaaLLH7j4eDXPRvw78tMflu7Ie2bzYOH4Y8rRKBY= +github.com/btcsuite/snappy-go v0.0.0-20151229074030-0bdef8d06723/go.mod h1:8woku9dyThutzjeg+3xrA5iCpBRH8XEEg3lh6TiUghc= +github.com/btcsuite/websocket v0.0.0-20150119174127-31079b680792/go.mod h1:ghJtEyQwv5/p4Mg4C0fgbePVuGr935/5ddU9Z3TmDRY= +github.com/btcsuite/winsvc v1.0.0/go.mod h1:jsenWakMcC0zFBFurPLEAyrnc/teJEM1O46fmI40EZs= +github.com/c-bata/go-prompt v0.2.2/go.mod h1:VzqtzE2ksDBcdln8G7mk2RX9QyGjH+OVqOCSiVIqS34= +github.com/census-instrumentation/opencensus-proto v0.2.1/go.mod h1:f6KPmirojxKA12rnyqOA5BBL4O983OfeGPqjHWSTneU= +github.com/cespare/cp v0.1.0 h1:SE+dxFebS7Iik5LK0tsi1k9ZCxEaFX4AjQmoyA+1dJk= +github.com/cespare/cp v0.1.0/go.mod h1:SOGHArjBr4JWaSDEVpWpo/hNg6RoKrls6Oh40hiwW+s= +github.com/cespare/xxhash v1.1.0 h1:a6HrQnmkObjyL+Gs60czilIUGqrzKutQD6XZog3p+ko= +github.com/cespare/xxhash v1.1.0/go.mod h1:XrSqR1VqqWfGrhpAt58auRo0WTKS1nRRg3ghfAqPWnc= +github.com/cespare/xxhash/v2 v2.1.1 h1:6MnRN8NT7+YBpUIWxHtefFZOKTAPgGjpQSxqLNn0+qY= +github.com/cespare/xxhash/v2 v2.1.1/go.mod h1:VGX0DQ3Q6kWi7AoAeZDth3/j3BFtOZR5XLFGgcrjCOs= +github.com/chzyer/logex v1.1.10/go.mod h1:+Ywpsq7O8HXn0nuIou7OrIPyXbp3wmkHB+jjWRnGsAI= +github.com/chzyer/readline v0.0.0-20180603132655-2972be24d48e/go.mod h1:nSuG5e5PlCu98SY8svDHJxuZscDgtXS6KTTbou5AhLI= +github.com/chzyer/test v0.0.0-20180213035817-a1ea475d72b1/go.mod h1:Q3SI9o4m/ZMnBNeIyt5eFwwo7qiLfzFZmjNmxjkiQlU= +github.com/client9/misspell v0.3.4/go.mod h1:qj6jICC3Q7zFZvVWo7KLAzC3yx5G7kyvSDkc90ppPyw= +github.com/cloudflare/cloudflare-go v0.14.0/go.mod h1:EnwdgGMaFOruiPZRFSgn+TsQ3hQ7C/YWzIGLeu5c304= +github.com/consensys/bavard v0.1.8-0.20210406032232-f3452dc9b572/go.mod h1:Bpd0/3mZuaj6Sj+PqrmIquiOKy397AKGThQPaGzNXAQ= +github.com/consensys/gnark-crypto v0.4.1-0.20210426202927-39ac3d4b3f1f/go.mod h1:815PAHg3wvysy0SyIqanF8gZ0Y1wjk/hrDHD/iT88+Q= +github.com/cpuguy83/go-md2man/v2 v2.0.0-20190314233015-f79a8a8ca69d/go.mod h1:maD7wRr/U5Z6m/iR4s+kqSMx2CaBsrgA7czyZG/E6dU= +github.com/dave/jennifer v1.2.0/go.mod h1:fIb+770HOpJ2fmN9EPPKOqm1vMGhB+TwXKMZhrIygKg= +github.com/davecgh/go-spew v0.0.0-20171005155431-ecdeabc65495/go.mod h1:J7Y8YcW2NihsgmVo/mv3lAwl/skON4iLHjSsI+c5H38= +github.com/davecgh/go-spew v1.1.0/go.mod h1:J7Y8YcW2NihsgmVo/mv3lAwl/skON4iLHjSsI+c5H38= +github.com/davecgh/go-spew v1.1.1 h1:vj9j/u1bqnvCEfJOwUhtlOARqs3+rkHYY13jYWTU97c= +github.com/davecgh/go-spew v1.1.1/go.mod h1:J7Y8YcW2NihsgmVo/mv3lAwl/skON4iLHjSsI+c5H38= +github.com/deckarep/golang-set v0.0.0-20180603214616-504e848d77ea h1:j4317fAZh7X6GqbFowYdYdI0L9bwxL07jyPZIdepyZ0= +github.com/deckarep/golang-set v0.0.0-20180603214616-504e848d77ea/go.mod h1:93vsz/8Wt4joVM7c2AVqh+YRMiUSc14yDtF28KmMOgQ= +github.com/dgrijalva/jwt-go v3.2.0+incompatible/go.mod h1:E3ru+11k8xSBh+hMPgOLZmtrrCbhqsmaPHjLKYnJCaQ= +github.com/dgryski/go-bitstream v0.0.0-20180413035011-3522498ce2c8/go.mod h1:VMaSuZ+SZcx/wljOQKvp5srsbCiKDEb6K2wC4+PiBmQ= +github.com/dgryski/go-sip13 v0.0.0-20181026042036-e10d5fee7954/go.mod h1:vAd38F8PWV+bWy6jNmig1y/TA+kYO4g3RSRF0IAv0no= +github.com/dlclark/regexp2 v1.2.0/go.mod h1:2pZnwuY/m+8K6iRw6wQdMtk+rH5tNGR1i55kozfMjCc= +github.com/docker/docker v1.4.2-0.20180625184442-8e610b2b55bf/go.mod h1:eEKB0N0r5NX/I1kEveEz05bcu8tLC/8azJZsviup8Sk= +github.com/dop251/goja v0.0.0-20200721192441-a695b0cdd498/go.mod h1:Mw6PkjjMXWbTj+nnj4s3QPXq1jaT0s5pC0iFD4+BOAA= +github.com/eclipse/paho.mqtt.golang v1.2.0/go.mod h1:H9keYFcgq3Qr5OUJm/JZI/i6U7joQ8SYLhZwfeOo6Ts= +github.com/edsrzf/mmap-go v1.0.0/go.mod h1:YO35OhQPt3KJa3ryjFM5Bs14WD66h8eGKpfaBNrHW5M= +github.com/envoyproxy/go-control-plane v0.9.1-0.20191026205805-5f8ba28d4473/go.mod h1:YTl/9mNaCwkRvm6d1a2C3ymFceY/DCBVvsKhRF0iEA4= +github.com/envoyproxy/protoc-gen-validate v0.1.0/go.mod h1:iSmxcyjqTsJpI2R4NaDN7+kN2VEUnK/pcBlmesArF7c= +github.com/ethereum/go-ethereum v1.10.6 h1:bfx3rqWgw768vn6ioxTk8pPNe4IaRzVgRlrS35B43es= +github.com/ethereum/go-ethereum v1.10.6/go.mod h1:iY/t0vHSmaAOC+xlqvAAeHdGSWNFkfSnN0OhMTDYz90= +github.com/fatih/color v1.7.0/go.mod h1:Zm6kSWBoL9eyXnKyktHP6abPY2pDugNf5KwzbycvMj4= +github.com/fjl/memsize v0.0.0-20190710130421-bcb5799ab5e5/go.mod h1:VvhXpOYNQvB+uIk2RvXzuaQtkQJzzIx6lSBe1xv7hi0= +github.com/fogleman/gg v1.2.1-0.20190220221249-0403632d5b90/go.mod h1:R/bRT+9gY/C5z7JzPU0zXsXHKM4/ayA+zqcVNZzPa1k= +github.com/fsnotify/fsnotify v1.4.7/go.mod h1:jwhsz4b93w/PPRr/qN1Yymfu8t87LnFCMoQvtojpjFo= +github.com/fsnotify/fsnotify v1.4.9 h1:hsms1Qyu0jgnwNXIxa+/V/PDsU6CfLf6CNO8H7IWoS4= +github.com/fsnotify/fsnotify v1.4.9/go.mod h1:znqG4EE+3YCdAaPaxE2ZRY/06pZUdp0tY4IgpuI1SZQ= +github.com/gballet/go-libpcsclite v0.0.0-20190607065134-2772fd86a8ff/go.mod h1:x7DCsMOv1taUwEWCzT4cmDeAkigA5/QCwUodaVOe8Ww= +github.com/glycerine/go-unsnap-stream v0.0.0-20180323001048-9f0cb55181dd/go.mod h1:/20jfyN9Y5QPEAprSgKAUr+glWDY39ZiUEAYOEv5dsE= +github.com/glycerine/goconvey v0.0.0-20190410193231-58a59202ab31/go.mod h1:Ogl1Tioa0aV7gstGFO7KhffUsb9M4ydbEbbxpcEDc24= +github.com/go-gl/glfw v0.0.0-20190409004039-e6da0acd62b1/go.mod h1:vR7hzQXu2zJy9AVAgeJqvqgH9Q5CA+iKCZ2gyEVpxRU= +github.com/go-gl/glfw/v3.3/glfw v0.0.0-20191125211704-12ad95a8df72/go.mod h1:tQ2UAYgL5IevRw8kRxooKSPJfGvJ9fJQFa0TUsXzTg8= +github.com/go-kit/kit v0.8.0 h1:Wz+5lgoB0kkuqLEc6NVmwRknTKP6dTGbSqvhZtBI/j0= +github.com/go-kit/kit v0.8.0/go.mod h1:xBxKIO96dXMWWy0MnWVtmwkA9/13aqxPnvrjFYMA2as= +github.com/go-logfmt/logfmt v0.3.0/go.mod h1:Qt1PoO58o5twSAckw1HlFXLmHsOX5/0LbT9GBnD5lWE= +github.com/go-logfmt/logfmt v0.4.0 h1:MP4Eh7ZCb31lleYCFuwm0oe4/YGak+5l1vA2NOE80nA= +github.com/go-logfmt/logfmt v0.4.0/go.mod h1:3RMwSq7FuexP4Kalkev3ejPJsZTpXXBr9+V4qmtdjCk= +github.com/go-ole/go-ole v1.2.1 h1:2lOsA72HgjxAuMlKpFiCbHTvu44PIVkZ5hqm3RSdI/E= +github.com/go-ole/go-ole v1.2.1/go.mod h1:7FAglXiTm7HKlQRDeOQ6ZNUHidzCWXuZWq/1dTyBNF8= +github.com/go-sourcemap/sourcemap v2.1.2+incompatible/go.mod h1:F8jJfvm2KbVjc5NqelyYJmf/v5J0dwNLS2mL4sNA1Jg= +github.com/go-sql-driver/mysql v1.4.1/go.mod h1:zAC/RDZ24gD3HViQzih4MyKcchzm+sOG5ZlKdlhCg5w= +github.com/go-stack/stack v1.8.0 h1:5SgMzNM5HxrEjV0ww2lTmX6E2Izsfxas4+YHWRs3Lsk= +github.com/go-stack/stack v1.8.0/go.mod h1:v0f6uXyyMGvRgIKkXu+yp6POWl0qKG85gN/melR3HDY= +github.com/gofrs/uuid v3.3.0+incompatible/go.mod h1:b2aQJv3Z4Fp6yNu3cdSllBxTCLRxnplIgP/c0N/04lM= +github.com/gogo/protobuf v1.1.1/go.mod h1:r8qH/GZQm5c6nD/R0oafs1akxWv10x8SbQlK7atdtwQ= +github.com/gogo/protobuf v1.3.1/go.mod h1:SlYgWuQ5SjCEi6WLHjHCa1yvBfUnHcTbrrZtXPKa29o= +github.com/golang/freetype v0.0.0-20170609003504-e2365dfdc4a0/go.mod h1:E/TSTwGwJL78qG/PmXZO1EjYhfJinVAhrmmHX6Z8B9k= +github.com/golang/geo v0.0.0-20190916061304-5b978397cfec/go.mod h1:QZ0nwyI2jOfgRAoBvP+ab5aRr7c9x7lhGEJrKvBwjWI= +github.com/golang/glog v0.0.0-20160126235308-23def4e6c14b/go.mod h1:SBH7ygxi8pfUlaOkMMuAQtPIUF8ecWP5IEl/CR7VP2Q= +github.com/golang/groupcache v0.0.0-20190702054246-869f871628b6/go.mod h1:cIg4eruTrX1D+g88fzRXU5OdNfaM+9IcxsU14FzY7Hc= +github.com/golang/groupcache v0.0.0-20191227052852-215e87163ea7/go.mod h1:cIg4eruTrX1D+g88fzRXU5OdNfaM+9IcxsU14FzY7Hc= +github.com/golang/mock v1.1.1/go.mod h1:oTYuIxOrZwtPieC+H1uAHpcLFnEyAGVDL/k47Jfbm0A= +github.com/golang/mock v1.2.0/go.mod h1:oTYuIxOrZwtPieC+H1uAHpcLFnEyAGVDL/k47Jfbm0A= +github.com/golang/mock v1.3.1/go.mod h1:sBzyDLLjw3U8JLTeZvSv8jJB+tU5PVekmnlKIyFUx0Y= +github.com/golang/protobuf v1.2.0/go.mod h1:6lQm79b+lXiMfvg/cZm0SGofjICqVBUtrP5yJMmIC1U= +github.com/golang/protobuf v1.3.1/go.mod h1:6lQm79b+lXiMfvg/cZm0SGofjICqVBUtrP5yJMmIC1U= +github.com/golang/protobuf v1.3.2/go.mod h1:6lQm79b+lXiMfvg/cZm0SGofjICqVBUtrP5yJMmIC1U= +github.com/golang/protobuf v1.4.0-rc.1/go.mod h1:ceaxUfeHdC40wWswd/P6IGgMaK3YpKi5j83Wpe3EHw8= +github.com/golang/protobuf v1.4.0-rc.1.0.20200221234624-67d41d38c208/go.mod h1:xKAWHe0F5eneWXFV3EuXVDTCmh+JuBKY0li0aMyXATA= +github.com/golang/protobuf v1.4.0-rc.2/go.mod h1:LlEzMj4AhA7rCAGe4KMBDvJI+AwstrUpVNzEA03Pprs= +github.com/golang/protobuf v1.4.0-rc.4.0.20200313231945-b860323f09d0/go.mod h1:WU3c8KckQ9AFe+yFwt9sWVRKCVIyN9cPHBJSNnbL67w= +github.com/golang/protobuf v1.4.0/go.mod h1:jodUvKwWbYaEsadDk5Fwe5c77LiNKVO9IDvqG2KuDX0= +github.com/golang/protobuf v1.4.2/go.mod h1:oDoupMAO8OvCJWAcko0GGGIgR6R6ocIYbsSw735rRwI= +github.com/golang/protobuf v1.4.3 h1:JjCZWpVbqXDqFVmTfYWEVTMIYrL/NPdPSCHPJ0T/raM= +github.com/golang/protobuf v1.4.3/go.mod h1:oDoupMAO8OvCJWAcko0GGGIgR6R6ocIYbsSw735rRwI= +github.com/golang/snappy v0.0.0-20180518054509-2e65f85255db/go.mod h1:/XxbfmMg8lxefKM7IXC3fBNl/7bRcc72aCRzEWrmP2Q= +github.com/golang/snappy v0.0.1/go.mod h1:/XxbfmMg8lxefKM7IXC3fBNl/7bRcc72aCRzEWrmP2Q= +github.com/golang/snappy v0.0.3 h1:fHPg5GQYlCeLIPB9BZqMVR5nR9A+IM5zcgeTdjMYmLA= +github.com/golang/snappy v0.0.3/go.mod h1:/XxbfmMg8lxefKM7IXC3fBNl/7bRcc72aCRzEWrmP2Q= +github.com/google/btree v0.0.0-20180813153112-4030bb1f1f0c/go.mod h1:lNA+9X1NB3Zf8V7Ke586lFgjr2dZNuvo3lPJSGZ5JPQ= +github.com/google/btree v1.0.0/go.mod h1:lNA+9X1NB3Zf8V7Ke586lFgjr2dZNuvo3lPJSGZ5JPQ= +github.com/google/flatbuffers v1.11.0/go.mod h1:1AeVuKshWv4vARoZatz6mlQ0JxURH0Kv5+zNeJKJCa8= +github.com/google/go-cmp v0.2.0/go.mod h1:oXzfMopK8JAjlY9xF4vHSVASa0yLyX7SntLO5aqRK0M= +github.com/google/go-cmp v0.3.0/go.mod h1:8QqcDgzrUqlUb/G2PQTWiueGozuR1884gddMywk6iLU= +github.com/google/go-cmp v0.3.1/go.mod h1:8QqcDgzrUqlUb/G2PQTWiueGozuR1884gddMywk6iLU= +github.com/google/go-cmp v0.4.0/go.mod h1:v8dTdLbMG2kIc/vJvl+f65V22dbkXbowE6jgT/gNBxE= +github.com/google/go-cmp v0.4.1/go.mod h1:v8dTdLbMG2kIc/vJvl+f65V22dbkXbowE6jgT/gNBxE= +github.com/google/go-cmp v0.5.4 h1:L8R9j+yAqZuZjsqh/z+F1NCffTKKLShY6zXTItVIZ8M= +github.com/google/go-cmp v0.5.4/go.mod h1:v8dTdLbMG2kIc/vJvl+f65V22dbkXbowE6jgT/gNBxE= +github.com/google/gofuzz v1.1.1-0.20200604201612-c04b05f3adfa/go.mod h1:dBl0BpW6vV/+mYPU4Po3pmUjxk6FQPldtuIdl/M65Eg= +github.com/google/martian v2.1.0+incompatible/go.mod h1:9I4somxYTbIHy5NJKHRl3wXiIaQGbYVAs8BPL6v8lEs= +github.com/google/pprof v0.0.0-20181206194817-3ea8567a2e57/go.mod h1:zfwlbNMJ+OItoe0UupaVj+oy1omPYYDuagoSzA8v9mc= +github.com/google/pprof v0.0.0-20190515194954-54271f7e092f/go.mod h1:zfwlbNMJ+OItoe0UupaVj+oy1omPYYDuagoSzA8v9mc= +github.com/google/pprof v0.0.0-20191218002539-d4f498aebedc/go.mod h1:ZgVRPoUq/hfqzAqh7sHMqb3I9Rq5C59dIz2SbBwJ4eM= +github.com/google/renameio v0.1.0/go.mod h1:KWCgfxg9yswjAJkECMjeO8J8rahYeXnNhOm40UhjYkI= +github.com/google/uuid v1.1.5 h1:kxhtnfFVi+rYdOALN0B3k9UT86zVJKfBimRaciULW4I= +github.com/google/uuid v1.1.5/go.mod h1:TIyPZe4MgqvfeYDBFedMoGGpEw/LqOeaOT+nhxU+yHo= +github.com/googleapis/gax-go/v2 v2.0.4/go.mod h1:0Wqv26UfaUD9n4G6kQubkQ+KchISgw+vpHVxEJEs9eg= +github.com/googleapis/gax-go/v2 v2.0.5/go.mod h1:DWXyrwAJ9X0FpwwEdw+IPEYBICEFu5mhpdKc/us6bOk= +github.com/gopherjs/gopherjs v0.0.0-20181017120253-0766667cb4d1/go.mod h1:wJfORRmW1u3UXTncJ5qlYoELFm8eSnnEO6hX4iZ3EWY= +github.com/gorilla/websocket v1.4.2/go.mod h1:YR8l580nyteQvAITg2hZ9XVh4b55+EU/adAjf1fMHhE= +github.com/graph-gophers/graphql-go v0.0.0-20201113091052-beb923fada29/go.mod h1:9CQHMSxwO4MprSdzoIEobiHpoLtHm77vfxsvsIN5Vuc= +github.com/hashicorp/golang-lru v0.5.0/go.mod h1:/m3WP610KZHVQ1SGc6re/UDhFvYD7pJ4Ao+sR/qLZy8= +github.com/hashicorp/golang-lru v0.5.1/go.mod h1:/m3WP610KZHVQ1SGc6re/UDhFvYD7pJ4Ao+sR/qLZy8= +github.com/hashicorp/golang-lru v0.5.5-0.20210104140557-80c98217689d/go.mod h1:iADmTwqILo4mZ8BN3D2Q6+9jd8WM5uGBxy+E8yxSoD4= +github.com/holiman/bloomfilter/v2 v2.0.3 h1:73e0e/V0tCydx14a0SCYS/EWCxgwLZ18CZcZKVu0fao= +github.com/holiman/bloomfilter/v2 v2.0.3/go.mod h1:zpoh+gs7qcpqrHr3dB55AMiJwo0iURXE7ZOP9L9hSkA= +github.com/holiman/uint256 v1.2.0/go.mod h1:y4ga/t+u+Xwd7CpDgZESaRcWy0I7XMlTMA25ApIH5Jw= +github.com/hpcloud/tail v1.0.0/go.mod h1:ab1qPbhIpdTxEkNHXyeSf5vhxWSCs/tWer42PpOxQnU= +github.com/huin/goupnp v1.0.1-0.20210626160114-33cdcbb30dda/go.mod h1:0dxJBVBHqTMjIUMkESDTNgOOx/Mw5wYIfyFmdzSamkM= +github.com/huin/goutil v0.0.0-20170803182201-1ca381bf3150/go.mod h1:PpLOETDnJ0o3iZrZfqZzyLl6l7F3c6L1oWn7OICBi6o= +github.com/ianlancetaylor/demangle v0.0.0-20181102032728-5e5cf60278f6/go.mod h1:aSSvb/t6k1mPoxDqO4vJh6VOCGPwU4O0C2/Eqndh1Sc= +github.com/inconshreveable/mousetrap v1.0.0/go.mod h1:PxqpIevigyE2G7u3NXJIT2ANytuPF1OarO4DADm73n8= +github.com/influxdata/flux v0.65.1/go.mod h1:J754/zds0vvpfwuq7Gc2wRdVwEodfpCFM7mYlOw2LqY= +github.com/influxdata/influxdb v1.8.3/go.mod h1:JugdFhsvvI8gadxOI6noqNeeBHvWNTbfYGtiAn+2jhI= +github.com/influxdata/influxql v1.1.1-0.20200828144457-65d3ef77d385/go.mod h1:gHp9y86a/pxhjJ+zMjNXiQAA197Xk9wLxaz+fGG+kWk= +github.com/influxdata/line-protocol v0.0.0-20180522152040-32c6aa80de5e/go.mod h1:4kt73NQhadE3daL3WhR5EJ/J2ocX0PZzwxQ0gXJ7oFE= +github.com/influxdata/promql/v2 v2.12.0/go.mod h1:fxOPu+DY0bqCTCECchSRtWfc+0X19ybifQhZoQNF5D8= +github.com/influxdata/roaring v0.4.13-0.20180809181101-fc520f41fab6/go.mod h1:bSgUQ7q5ZLSO+bKBGqJiCBGAl+9DxyW63zLTujjUlOE= +github.com/influxdata/tdigest v0.0.0-20181121200506-bf2b5ad3c0a9/go.mod h1:Js0mqiSBE6Ffsg94weZZ2c+v/ciT8QRHFOap7EKDrR0= +github.com/influxdata/usage-client v0.0.0-20160829180054-6d3895376368/go.mod h1:Wbbw6tYNvwa5dlB6304Sd+82Z3f7PmVZHVKU637d4po= +github.com/jackpal/go-nat-pmp v1.0.2-0.20160603034137-1fa385a6f458/go.mod h1:QPH045xvCAeXUZOxsnwmrtiCoxIr9eob+4orBN1SBKc= +github.com/jedisct1/go-minisign v0.0.0-20190909160543-45766022959e/go.mod h1:G1CVv03EnqU1wYL2dFwXxW2An0az9JTl/ZsqXQeBlkU= +github.com/jessevdk/go-flags v0.0.0-20141203071132-1679536dcc89/go.mod h1:4FA24M0QyGHXBuZZK/XkWh8h0e1EYbRYJSGM75WSRxI= +github.com/jmespath/go-jmespath v0.4.0/go.mod h1:T8mJZnbsbmF+m6zOOFylbeCJqk5+pHWvzYPziyZiYoo= +github.com/jmespath/go-jmespath/internal/testify v1.5.1/go.mod h1:L3OGu8Wl2/fWfCI6z80xFu9LTZmf1ZRjMHUOPmWr69U= +github.com/jrick/logrotate v1.0.0/go.mod h1:LNinyqDIJnpAur+b8yyulnQw/wDuN1+BYKlTRt3OuAQ= +github.com/json-iterator/go v1.1.6/go.mod h1:+SdeFBvtyEkXs7REEP0seUULqWtbJapLOCVDaaPEHmU= +github.com/jstemmer/go-junit-report v0.0.0-20190106144839-af01ea7f8024/go.mod h1:6v2b51hI/fHJwM22ozAgKL4VKDeJcHhJFhtBdhmNjmU= +github.com/jstemmer/go-junit-report v0.9.1/go.mod h1:Brl9GWCQeLvo8nXZwPNNblvFj/XSXhF0NWZEnDohbsk= +github.com/jsternberg/zap-logfmt v1.0.0/go.mod h1:uvPs/4X51zdkcm5jXl5SYoN+4RK21K8mysFmDaM/h+o= +github.com/jtolds/gls v4.20.0+incompatible/go.mod h1:QJZ7F/aHp+rZTRtaJ1ow/lLfFfVYBRgL+9YlvaHOwJU= +github.com/julienschmidt/httprouter v1.2.0/go.mod h1:SYymIcj16QtmaHHD7aYtjjsJG7VTCxuUUipMqKk8s4w= +github.com/jung-kurt/gofpdf v1.0.3-0.20190309125859-24315acbbda5/go.mod h1:7Id9E/uU8ce6rXgefFLlgrJj/GYY22cpxn+r32jIOes= +github.com/jwilder/encoding v0.0.0-20170811194829-b4e1701a28ef/go.mod h1:Ct9fl0F6iIOGgxJ5npU/IUOhOhqlVrGjyIZc8/MagT0= +github.com/karalabe/usb v0.0.0-20190919080040-51dc0efba356 h1:I/yrLt2WilKxlQKCM52clh5rGzTKpVctGT1lH4Dc8Jw= +github.com/karalabe/usb v0.0.0-20190919080040-51dc0efba356/go.mod h1:Od972xHfMJowv7NGVDiWVxk2zxnWgjLlJzE+F4F7AGU= +github.com/kisielk/errcheck v1.2.0/go.mod h1:/BMXB+zMLi60iA8Vv6Ksmxu/1UDYcXs4uQLJ+jE2L00= +github.com/kisielk/gotool v1.0.0/go.mod h1:XhKaO+MFFWcvkIS/tQcRk01m1F5IRFswLeQ+oQHNcck= +github.com/kkdai/bstream v0.0.0-20161212061736-f391b8402d23/go.mod h1:J+Gs4SYgM6CZQHDETBtE9HaSEkGmuNXF86RwHhHUvq4= +github.com/klauspost/compress v1.4.0/go.mod h1:RyIbtBH6LamlWaDj8nUwkbUhJ87Yi3uG0guNDohfE1A= +github.com/klauspost/cpuid v0.0.0-20170728055534-ae7887de9fa5/go.mod h1:Pj4uuM528wm8OyEC2QMXAi2YiTZ96dNQPGgoMS4s3ek= +github.com/klauspost/crc32 v0.0.0-20161016154125-cb6bfca970f6/go.mod h1:+ZoRqAPRLkC4NPOvfYeR5KNOrY6TD+/sAC3HXPZgDYg= +github.com/klauspost/pgzip v1.0.2-0.20170402124221-0bf5dcad4ada/go.mod h1:Ch1tH69qFZu15pkjo5kYi6mth2Zzwzt50oCQKQE9RUs= +github.com/konsorten/go-windows-terminal-sequences v1.0.1/go.mod h1:T0+1ngSBFLxvqU3pZ+m/2kptfBszLMUkC4ZK/EgS/cQ= +github.com/kr/logfmt v0.0.0-20140226030751-b84e30acd515 h1:T+h1c/A9Gawja4Y9mFVWj2vyii2bbUNDw3kt9VxK2EY= +github.com/kr/logfmt v0.0.0-20140226030751-b84e30acd515/go.mod h1:+0opPa2QZZtGFBFZlji/RkVcI2GknAs/DXo4wKdlNEc= +github.com/kr/pretty v0.1.0 h1:L/CwN0zerZDmRFUapSPitk6f+Q3+0za1rQkzVuMiMFI= +github.com/kr/pretty v0.1.0/go.mod h1:dAy3ld7l9f0ibDNOQOHHMYYIIbhfbHSm3C4ZsoJORNo= +github.com/kr/pty v1.1.1/go.mod h1:pFQYn66WHrOpPYNljwOMqo10TkYh1fy3cYio2l3bCsQ= +github.com/kr/text v0.1.0 h1:45sCR5RtlFHMR4UwH9sdQ5TC8v0qDQCHnXt+kaKSTVE= +github.com/kr/text v0.1.0/go.mod h1:4Jbv+DJW3UT/LiOwJeYQe1efqtUx/iVham/4vfdArNI= +github.com/kylelemons/godebug v1.1.0/go.mod h1:9/0rRGxNHcop5bhtWyNeEfOS8JIWk580+fNqagV/RAw= +github.com/leanovate/gopter v0.2.9/go.mod h1:U2L/78B+KVFIx2VmW6onHJQzXtFb+p5y3y2Sh+Jxxv8= +github.com/lib/pq v1.0.0/go.mod h1:5WUZQaWbwv1U+lTReE5YruASi9Al49XbQIvNi/34Woo= +github.com/mattn/go-colorable v0.0.9/go.mod h1:9vuHe8Xs5qXnSaW/c/ABM9alt+Vo+STaOChaDxuIBZU= +github.com/mattn/go-colorable v0.1.0/go.mod h1:9vuHe8Xs5qXnSaW/c/ABM9alt+Vo+STaOChaDxuIBZU= +github.com/mattn/go-ieproxy v0.0.0-20190610004146-91bb50d98149/go.mod h1:31jz6HNzdxOmlERGGEc4v/dMssOfmp2p5bT/okiKFFc= +github.com/mattn/go-ieproxy v0.0.0-20190702010315-6dee0af9227d/go.mod h1:31jz6HNzdxOmlERGGEc4v/dMssOfmp2p5bT/okiKFFc= +github.com/mattn/go-isatty v0.0.4/go.mod h1:M+lRXTBqGeGNdLjl/ufCoiOlB5xdOkqRJdNxMWT7Zi4= +github.com/mattn/go-isatty v0.0.5-0.20180830101745-3fb116b82035/go.mod h1:M+lRXTBqGeGNdLjl/ufCoiOlB5xdOkqRJdNxMWT7Zi4= +github.com/mattn/go-runewidth v0.0.3/go.mod h1:LwmH8dsx7+W8Uxz3IHJYH5QSwggIsqBzpuz5H//U1FU= +github.com/mattn/go-runewidth v0.0.9 h1:Lm995f3rfxdpd6TSmuVCHVb/QhupuXlYr8sCI/QdE+0= +github.com/mattn/go-runewidth v0.0.9/go.mod h1:H031xJmbD/WCDINGzjvQ9THkh0rPKHF+m2gUSrubnMI= +github.com/mattn/go-sqlite3 v1.11.0/go.mod h1:FPy6KqzDD04eiIsT53CuJW3U88zkxoIYsOqkbpncsNc= +github.com/mattn/go-tty v0.0.0-20180907095812-13ff1204f104/go.mod h1:XPvLUNfbS4fJH25nqRHfWLMa1ONC8Amw+mIA639KxkE= +github.com/matttproud/golang_protobuf_extensions v1.0.1/go.mod h1:D8He9yQNgCq6Z5Ld7szi9bcBfOoFv/3dc6xSMkL2PC0= +github.com/modern-go/concurrent v0.0.0-20180306012644-bacd9c7ef1dd/go.mod h1:6dJC0mAP4ikYIbvyc7fijjWJddQyLn8Ig3JB5CqoB9Q= +github.com/modern-go/reflect2 v1.0.1/go.mod h1:bx2lNnkwVCuqBIxFjflWJWanXIb3RllmbCylyMrvgv0= +github.com/mschoch/smat v0.0.0-20160514031455-90eadee771ae/go.mod h1:qAyveg+e4CE+eKJXWVjKXM4ck2QobLqTDytGJbLLhJg= +github.com/mwitkow/go-conntrack v0.0.0-20161129095857-cc309e4a2223/go.mod h1:qRWi+5nqEBWmkhHvq77mSJWrCKwh8bxhgT7d/eI7P4U= +github.com/naoina/go-stringutil v0.1.0/go.mod h1:XJ2SJL9jCtBh+P9q5btrd/Ylo8XwT/h1USek5+NqSA0= +github.com/naoina/toml v0.1.2-0.20170918210437-9fafd6967416/go.mod h1:NBIhNtsFMo3G2szEBne+bO4gS192HuIYRqfvOWb4i1E= +github.com/nxadm/tail v1.4.4 h1:DQuhQpB1tVlglWS2hLQ5OV6B5r8aGxSrPc5Qo6uTN78= +github.com/nxadm/tail v1.4.4/go.mod h1:kenIhsEOeOJmVchQTgglprH7qJGnHDVpk1VPCcaMI8A= +github.com/oklog/ulid v1.3.1/go.mod h1:CirwcVhetQ6Lv90oh/F+FBtV6XMibvdAFo93nm5qn4U= +github.com/olekukonko/tablewriter v0.0.5 h1:P2Ga83D34wi1o9J6Wh1mRuqd4mF/x/lgBS7N7AbDhec= +github.com/olekukonko/tablewriter v0.0.5/go.mod h1:hPp6KlRPjbx+hW8ykQs1w3UBbZlj6HuIJcUGPhkA7kY= +github.com/onsi/ginkgo v1.6.0/go.mod h1:lLunBs/Ym6LB5Z9jYTR76FiuTmxDTDusOGeTQH+WWjE= +github.com/onsi/ginkgo v1.7.0/go.mod h1:lLunBs/Ym6LB5Z9jYTR76FiuTmxDTDusOGeTQH+WWjE= +github.com/onsi/ginkgo v1.12.1/go.mod h1:zj2OWP4+oCPe1qIXoGWkgMRwljMUYCdkwsT2108oapk= +github.com/onsi/ginkgo v1.14.0 h1:2mOpI4JVVPBN+WQRa0WKH2eXR+Ey+uK4n7Zj0aYpIQA= +github.com/onsi/ginkgo v1.14.0/go.mod h1:iSB4RoI2tjJc9BBv4NKIKWKya62Rps+oPG/Lv9klQyY= +github.com/onsi/gomega v1.4.3/go.mod h1:ex+gbHU/CVuBBDIJjb2X0qEXbFg53c61hWP/1CpauHY= +github.com/onsi/gomega v1.7.1/go.mod h1:XdKZgCCFLUoM/7CFJVPcG8C1xQ1AJ0vpAezJrB7JYyY= +github.com/onsi/gomega v1.10.1 h1:o0+MgICZLuZ7xjH7Vx6zS/zcu93/BEp1VwkIW1mEXCE= +github.com/onsi/gomega v1.10.1/go.mod h1:iN09h71vgCQne3DLsj+A5owkum+a2tYe+TOCB1ybHNo= +github.com/opentracing/opentracing-go v1.0.2/go.mod h1:UkNAQd3GIcIGf0SeVgPpRdFStlNbqXla1AfSYxPUl2o= +github.com/opentracing/opentracing-go v1.0.3-0.20180606204148-bd9c31933947/go.mod h1:UkNAQd3GIcIGf0SeVgPpRdFStlNbqXla1AfSYxPUl2o= +github.com/opentracing/opentracing-go v1.1.0/go.mod h1:UkNAQd3GIcIGf0SeVgPpRdFStlNbqXla1AfSYxPUl2o= +github.com/paulbellamy/ratecounter v0.2.0/go.mod h1:Hfx1hDpSGoqxkVVpBi/IlYD7kChlfo5C6hzIHwPqfFE= +github.com/peterh/liner v1.0.1-0.20180619022028-8c1271fcf47f/go.mod h1:xIteQHvHuaLYG9IFj6mSxM0fCKrs34IrEQUhOYuGPHc= +github.com/peterh/liner v1.1.1-0.20190123174540-a2c9a5303de7/go.mod h1:CRroGNssyjTd/qIG2FyxByd2S8JEAZXBl4qUrZf8GS0= +github.com/philhofer/fwd v1.0.0/go.mod h1:gk3iGcWd9+svBvR0sR+KPcfE+RNWozjowpeBVG3ZVNU= +github.com/pierrec/lz4 v2.0.5+incompatible/go.mod h1:pdkljMzZIN41W+lC3N2tnIh5sFi+IEE17M5jbnwPHcY= +github.com/pkg/errors v0.8.0/go.mod h1:bwawxfHBFNV+L2hUp1rHADufV3IMtnDRdf1r5NINEl0= +github.com/pkg/errors v0.8.1/go.mod h1:bwawxfHBFNV+L2hUp1rHADufV3IMtnDRdf1r5NINEl0= +github.com/pkg/errors v0.9.1 h1:FEBLx1zS214owpjy7qsBeixbURkuhQAwrK5UwLGTwt4= +github.com/pkg/errors v0.9.1/go.mod h1:bwawxfHBFNV+L2hUp1rHADufV3IMtnDRdf1r5NINEl0= +github.com/pkg/term v0.0.0-20180730021639-bffc007b7fd5/go.mod h1:eCbImbZ95eXtAUIbLAuAVnBnwf83mjf6QIVH8SHYwqQ= +github.com/pmezard/go-difflib v1.0.0 h1:4DBwDE0NGyQoBHbLQYPwSUPoCMWR5BEzIk/f1lZbAQM= +github.com/pmezard/go-difflib v1.0.0/go.mod h1:iKH77koFhYxTK1pcRnkKkqfTogsbg7gZNVY4sRDYZ/4= +github.com/prometheus/client_golang v0.9.1/go.mod h1:7SWBe2y4D6OKWSNQJUaRYU/AaXPKyh/dDVn+NZz0KFw= +github.com/prometheus/client_golang v1.0.0/go.mod h1:db9x61etRT2tGnBNRi70OPL5FsnadC4Ky3P0J6CfImo= +github.com/prometheus/client_model v0.0.0-20180712105110-5c3871d89910/go.mod h1:MbSGuTsp3dbXC40dX6PRTWyKYBIrTGTE9sqQNg2J8bo= +github.com/prometheus/client_model v0.0.0-20190129233127-fd36f4220a90/go.mod h1:xMI15A0UPsDsEKsMN9yxemIoYk6Tm2C1GtYGdfGttqA= +github.com/prometheus/client_model v0.0.0-20190812154241-14fe0d1b01d4/go.mod h1:xMI15A0UPsDsEKsMN9yxemIoYk6Tm2C1GtYGdfGttqA= +github.com/prometheus/common v0.0.0-20181113130724-41aa239b4cce/go.mod h1:daVV7qP5qjZbuso7PdcryaAu0sAZbrN9i7WWcTMWvro= +github.com/prometheus/common v0.4.1/go.mod h1:TNfzLD0ON7rHzMJeJkieUDPYmFC7Snx/y86RQel1bk4= +github.com/prometheus/common v0.6.0/go.mod h1:eBmuwkDJBwy6iBfxCBob6t6dR6ENT/y+J+Zk0j9GMYc= +github.com/prometheus/procfs v0.0.0-20181005140218-185b4288413d/go.mod h1:c3At6R/oaqEKCNdg8wHV1ftS6bRYblBhIjjI8uT2IGk= +github.com/prometheus/procfs v0.0.2/go.mod h1:TjEm7ze935MbeOT/UhFTIMYKhuLP4wbCsTZCD3I8kEA= +github.com/prometheus/tsdb v0.7.1 h1:YZcsG11NqnK4czYLrWd9mpEuAJIHVQLwdrleYfszMAA= +github.com/prometheus/tsdb v0.7.1/go.mod h1:qhTCs0VvXwvX/y3TZrWD7rabWM+ijKTux40TwIPHuXU= +github.com/retailnext/hllpp v1.0.1-0.20180308014038-101a6d2f8b52/go.mod h1:RDpi1RftBQPUCDRw6SmxeaREsAaRKnOclghuzp/WRzc= +github.com/rjeczalik/notify v0.9.1 h1:CLCKso/QK1snAlnhNR/CNvNiFU2saUtjV0bx3EwNeCE= +github.com/rjeczalik/notify v0.9.1/go.mod h1:rKwnCoCGeuQnwBtTSPL9Dad03Vh2n40ePRrjvIXnJho= +github.com/rogpeppe/go-internal v1.3.0/go.mod h1:M8bDsm7K2OlrFYOpmOWEs/qY81heoFRclV5y23lUDJ4= +github.com/rs/cors v1.7.0/go.mod h1:gFx+x8UowdsKA9AchylcLynDq+nNFfI8FkUZdN/jGCU= +github.com/russross/blackfriday/v2 v2.0.1/go.mod h1:+Rmxgy9KzJVeS9/2gXHxylqXiyQDYRxCVz55jmeOWTM= +github.com/segmentio/kafka-go v0.1.0/go.mod h1:X6itGqS9L4jDletMsxZ7Dz+JFWxM6JHfPOCvTvk+EJo= +github.com/segmentio/kafka-go v0.2.0/go.mod h1:X6itGqS9L4jDletMsxZ7Dz+JFWxM6JHfPOCvTvk+EJo= +github.com/sergi/go-diff v1.0.0/go.mod h1:0CfEIISq7TuYL3j771MWULgwwjU+GofnZX9QAmXWZgo= +github.com/shirou/gopsutil v3.21.4-0.20210419000835-c7a38de76ee5+incompatible h1:Bn1aCHHRnjv4Bl16T8rcaFjYSrGrIZvpiGO6P3Q4GpU= +github.com/shirou/gopsutil v3.21.4-0.20210419000835-c7a38de76ee5+incompatible/go.mod h1:5b4v6he4MtMOwMlS0TUMTu2PcXUg8+E1lC7eC3UO/RA= +github.com/shurcooL/sanitized_anchor_name v1.0.0/go.mod h1:1NzhyTcUVG4SuEtjjoZeVRXNmyL/1OwPU0+IJeTBvfc= +github.com/sirupsen/logrus v1.2.0/go.mod h1:LxeOpSwHxABJmUn/MG1IvRgCAasNZTLOkJPxbbu5VWo= +github.com/smartystreets/assertions v0.0.0-20180927180507-b2de0cb4f26d/go.mod h1:OnSkiWE9lh6wB0YB77sQom3nweQdgAjqCqsofrRNTgc= +github.com/smartystreets/goconvey v1.6.4/go.mod h1:syvi0/a8iFYH4r/RixwvyeAJjdLS9QV7WQ/tjFTllLA= +github.com/spaolacci/murmur3 v0.0.0-20180118202830-f09979ecbc72/go.mod h1:JwIasOWyU6f++ZhiEuf87xNszmSA2myDM2Kzu9HwQUA= +github.com/spf13/cast v1.3.0/go.mod h1:Qx5cxh0v+4UWYiBimWS+eyWzqEqokIECu5etghLkUJE= +github.com/spf13/cobra v0.0.3/go.mod h1:1l0Ry5zgKvJasoi3XT1TypsSe7PqH0Sj9dhYf7v3XqQ= +github.com/spf13/pflag v1.0.3/go.mod h1:DYY7MBk1bdzusC3SYhjObp+wFpr4gzcvqqNjLnInEg4= +github.com/status-im/keycard-go v0.0.0-20190316090335-8537d3370df4/go.mod h1:RZLeN1LMWmRsyYjvAu+I6Dm9QmlDaIIt+Y+4Kd7Tp+Q= +github.com/stretchr/objx v0.1.0/go.mod h1:HFkY916IF+rwdDfMAkV7OtwuqBVzrE8GR6GFx+wExME= +github.com/stretchr/objx v0.1.1/go.mod h1:HFkY916IF+rwdDfMAkV7OtwuqBVzrE8GR6GFx+wExME= +github.com/stretchr/testify v1.2.0/go.mod h1:a8OnRcib4nhh0OaRAV+Yts87kKdq0PP7pXfy6kDkUVs= +github.com/stretchr/testify v1.2.2/go.mod h1:a8OnRcib4nhh0OaRAV+Yts87kKdq0PP7pXfy6kDkUVs= +github.com/stretchr/testify v1.3.0/go.mod h1:M5WIy9Dh21IEIfnGCwXGc5bZfKNJtfHm1UVUgZn+9EI= +github.com/stretchr/testify v1.4.0/go.mod h1:j7eGeouHqKxXV5pUuKE4zz7dFj8WfuZ+81PSLYec5m4= +github.com/stretchr/testify v1.7.0 h1:nwc3DEeHmmLAfoZucVR881uASk0Mfjw8xYJ99tb5CcY= +github.com/stretchr/testify v1.7.0/go.mod h1:6Fq8oRcR53rry900zMqJjRRixrwX3KX962/h/Wwjteg= +github.com/syndtr/goleveldb v1.0.1-0.20210305035536-64b5b1c73954 h1:xQdMZ1WLrgkkvOZ/LDQxjVxMLdby7osSh4ZEVa5sIjs= +github.com/syndtr/goleveldb v1.0.1-0.20210305035536-64b5b1c73954/go.mod h1:u2MKkTVTVJWe5D1rCvame8WqhBd88EuIwODJZ1VHCPM= +github.com/tinylib/msgp v1.0.2/go.mod h1:+d+yLhGm8mzTaHzB+wgMYrodPfmZrzkirds8fDWklFE= +github.com/tklauser/go-sysconf v0.3.5 h1:uu3Xl4nkLzQfXNsWn15rPc/HQCJKObbt1dKJeWp3vU4= +github.com/tklauser/go-sysconf v0.3.5/go.mod h1:MkWzOF4RMCshBAMXuhXJs64Rte09mITnppBXY/rYEFI= +github.com/tklauser/numcpus v0.2.2 h1:oyhllyrScuYI6g+h/zUvNXNp1wy7x8qQy3t/piefldA= +github.com/tklauser/numcpus v0.2.2/go.mod h1:x3qojaO3uyYt0i56EW/VUYs7uBvdl2fkfZFu0T9wgjM= +github.com/tyler-smith/go-bip39 v1.0.1-0.20181017060643-dbb3b84ba2ef/go.mod h1:sJ5fKU0s6JVwZjjcUEX2zFOnvq0ASQ2K9Zr6cf67kNs= +github.com/urfave/cli/v2 v2.3.0/go.mod h1:LJmUH05zAU44vOAcrfzZQKsZbVcdbOG8rtL3/XcUArI= +github.com/willf/bitset v1.1.3/go.mod h1:RjeCKbqT1RxIR/KWY6phxZiaY1IyutSBfGjNPySAYV4= +github.com/xlab/treeprint v0.0.0-20180616005107-d6fb6747feb6/go.mod h1:ce1O1j6UtZfjr22oyGxGLbauSBp2YVXpARAosm7dHBg= +github.com/yuin/goldmark v1.2.1/go.mod h1:3hX8gzYuyVAZsxl0MRgGTJEmQBFcNTphYh9decYSb74= +go.opencensus.io v0.21.0/go.mod h1:mSImk1erAIZhrmZN+AvHh14ztQfjbGwt4TtuofqLduU= +go.opencensus.io v0.22.0/go.mod h1:+kGneAE2xo2IficOXnaByMWTGM9T73dGwxeWcUqIpI8= +go.opencensus.io v0.22.2/go.mod h1:yxeiOL68Rb0Xd1ddK5vPZ/oVn4vY4Ynel7k9FzqtOIw= +go.uber.org/atomic v1.3.2/go.mod h1:gD2HeocX3+yG+ygLZcrzQJaqmWj9AIm7n08wl/qW/PE= +go.uber.org/multierr v1.1.0/go.mod h1:wR5kodmAFQ0UK8QlbwjlSNy0Z68gJhDJUG5sjR94q/0= +go.uber.org/zap v1.9.1/go.mod h1:vwi/ZaCAaUcBkycHslxD9B2zi4UTXhF60s6SWpuDF0Q= +golang.org/x/crypto v0.0.0-20170930174604-9419663f5a44/go.mod h1:6SG95UA2DQfeDnfUPMdvaQW0Q7yPrPDi9nlGo2tz2b4= +golang.org/x/crypto v0.0.0-20180904163835-0709b304e793/go.mod h1:6SG95UA2DQfeDnfUPMdvaQW0Q7yPrPDi9nlGo2tz2b4= +golang.org/x/crypto v0.0.0-20190308221718-c2843e01d9a2/go.mod h1:djNgcEr1/C05ACkg1iLfiJU5Ep61QUkGW8qpdssI0+w= +golang.org/x/crypto v0.0.0-20190510104115-cbcb75029529/go.mod h1:yigFU9vqHzYiE8UmvKecakEJjdnWj3jj499lnFckfCI= +golang.org/x/crypto v0.0.0-20190605123033-f99c8df09eb5/go.mod h1:yigFU9vqHzYiE8UmvKecakEJjdnWj3jj499lnFckfCI= +golang.org/x/crypto v0.0.0-20190909091759-094676da4a83/go.mod h1:yigFU9vqHzYiE8UmvKecakEJjdnWj3jj499lnFckfCI= +golang.org/x/crypto v0.0.0-20191011191535-87dc89f01550/go.mod h1:yigFU9vqHzYiE8UmvKecakEJjdnWj3jj499lnFckfCI= +golang.org/x/crypto v0.0.0-20200622213623-75b288015ac9/go.mod h1:LzIPMQfyMNhhGPhUkYOs5KpL4U8rLKemX1yGLhDgUto= +golang.org/x/crypto v0.0.0-20210322153248-0c34fe9e7dc2 h1:It14KIkyBFYkHkwZ7k45minvA9aorojkyjGk9KJ5B/w= +golang.org/x/crypto v0.0.0-20210322153248-0c34fe9e7dc2/go.mod h1:T9bdIzuCu7OtxOm1hfPfRQxPLYneinmdGuTeoZ9dtd4= +golang.org/x/exp v0.0.0-20180321215751-8460e604b9de/go.mod h1:CJ0aWSM057203Lf6IL+f9T1iT9GByDxfZKAQTCR3kQA= +golang.org/x/exp v0.0.0-20180807140117-3d87b88a115f/go.mod h1:CJ0aWSM057203Lf6IL+f9T1iT9GByDxfZKAQTCR3kQA= +golang.org/x/exp v0.0.0-20190121172915-509febef88a4/go.mod h1:CJ0aWSM057203Lf6IL+f9T1iT9GByDxfZKAQTCR3kQA= +golang.org/x/exp v0.0.0-20190125153040-c74c464bbbf2/go.mod h1:CJ0aWSM057203Lf6IL+f9T1iT9GByDxfZKAQTCR3kQA= +golang.org/x/exp v0.0.0-20190306152737-a1d7652674e8/go.mod h1:CJ0aWSM057203Lf6IL+f9T1iT9GByDxfZKAQTCR3kQA= +golang.org/x/exp v0.0.0-20190510132918-efd6b22b2522/go.mod h1:ZjyILWgesfNpC6sMxTJOJm9Kp84zZh5NQWvqDGG3Qr8= +golang.org/x/exp v0.0.0-20190829153037-c13cbed26979/go.mod h1:86+5VVa7VpoJ4kLfm080zCjGlMRFzhUhsZKEZO7MGek= +golang.org/x/exp v0.0.0-20191030013958-a1ab85dbe136/go.mod h1:JXzH8nQsPlswgeRAPE3MuO9GYsAcnJvJ4vnMwN/5qkY= +golang.org/x/exp v0.0.0-20191129062945-2f5052295587/go.mod h1:2RIsYlXP63K8oxa1u096TMicItID8zy7Y6sNkU49FU4= +golang.org/x/exp v0.0.0-20191227195350-da58074b4299/go.mod h1:2RIsYlXP63K8oxa1u096TMicItID8zy7Y6sNkU49FU4= +golang.org/x/image v0.0.0-20180708004352-c73c2afc3b81/go.mod h1:ux5Hcp/YLpHSI86hEcLt0YII63i6oz57MZXIpbrjZUs= +golang.org/x/image v0.0.0-20190227222117-0694c2d4d067/go.mod h1:kZ7UVZpmo3dzQBMxlp+ypCbDeSB+sBbTgSJuh5dn5js= +golang.org/x/image v0.0.0-20190802002840-cff245a6509b/go.mod h1:FeLwcggjj3mMvU+oOTbSwawSJRM1uh48EjtB4UJZlP0= +golang.org/x/lint v0.0.0-20181026193005-c67002cb31c3/go.mod h1:UVdnD1Gm6xHRNCYTkRU2/jEulfH38KcIWyp/GAMgvoE= +golang.org/x/lint v0.0.0-20190227174305-5b3e6a55c961/go.mod h1:wehouNa3lNwaWXcvxsM5YxQ5yQlVC4a0KAMCusXpPoU= +golang.org/x/lint v0.0.0-20190301231843-5614ed5bae6f/go.mod h1:UVdnD1Gm6xHRNCYTkRU2/jEulfH38KcIWyp/GAMgvoE= +golang.org/x/lint v0.0.0-20190313153728-d0100b6bd8b3/go.mod h1:6SW0HCj/g11FgYtHlgUYUwCkIfeOF89ocIRzGO/8vkc= +golang.org/x/lint v0.0.0-20190409202823-959b441ac422/go.mod h1:6SW0HCj/g11FgYtHlgUYUwCkIfeOF89ocIRzGO/8vkc= +golang.org/x/lint v0.0.0-20190909230951-414d861bb4ac/go.mod h1:6SW0HCj/g11FgYtHlgUYUwCkIfeOF89ocIRzGO/8vkc= +golang.org/x/lint v0.0.0-20190930215403-16217165b5de/go.mod h1:6SW0HCj/g11FgYtHlgUYUwCkIfeOF89ocIRzGO/8vkc= +golang.org/x/lint v0.0.0-20191125180803-fdd1cda4f05f/go.mod h1:5qLYkcX4OjUUV8bRuDixDT3tpyyb+LUpUlRWLxfhWrs= +golang.org/x/mobile v0.0.0-20190312151609-d3739f865fa6/go.mod h1:z+o9i4GpDbdi3rU15maQ/Ox0txvL9dWGYEHz965HBQE= +golang.org/x/mobile v0.0.0-20190719004257-d2bd2a29d028/go.mod h1:E/iHnbuqvinMTCcRqshq8CkpyQDoeVncDDYHnLhea+o= +golang.org/x/mod v0.0.0-20190513183733-4bf6d317e70e/go.mod h1:mXi4GBBbnImb6dmsKGUJ2LatrhH/nqhxcFungHvyanc= +golang.org/x/mod v0.1.0/go.mod h1:0QHyrYULN0/3qlju5TqG8bIK38QM8yzMo5ekMj3DlcY= +golang.org/x/mod v0.1.1-0.20191105210325-c90efee705ee/go.mod h1:QqPTAvyqsEbceGzBzNggFXnrqF1CaUcvgkdR5Ot7KZg= +golang.org/x/mod v0.3.0/go.mod h1:s0Qsj1ACt9ePp/hMypM3fl4fZqREWJwdYDEqhRiZZUA= +golang.org/x/mod v0.4.2/go.mod h1:s0Qsj1ACt9ePp/hMypM3fl4fZqREWJwdYDEqhRiZZUA= +golang.org/x/net v0.0.0-20180724234803-3673e40ba225/go.mod h1:mL1N/T3taQHkDXs73rZJwtUhF3w3ftmwwsq0BUmARs4= +golang.org/x/net v0.0.0-20180826012351-8a410e7b638d/go.mod h1:mL1N/T3taQHkDXs73rZJwtUhF3w3ftmwwsq0BUmARs4= +golang.org/x/net v0.0.0-20180906233101-161cd47e91fd/go.mod h1:mL1N/T3taQHkDXs73rZJwtUhF3w3ftmwwsq0BUmARs4= +golang.org/x/net v0.0.0-20181114220301-adae6a3d119a/go.mod h1:mL1N/T3taQHkDXs73rZJwtUhF3w3ftmwwsq0BUmARs4= +golang.org/x/net v0.0.0-20190108225652-1e06a53dbb7e/go.mod h1:mL1N/T3taQHkDXs73rZJwtUhF3w3ftmwwsq0BUmARs4= +golang.org/x/net v0.0.0-20190213061140-3a22650c66bd/go.mod h1:mL1N/T3taQHkDXs73rZJwtUhF3w3ftmwwsq0BUmARs4= +golang.org/x/net v0.0.0-20190311183353-d8887717615a/go.mod h1:t9HGtf8HONx5eT2rtn7q6eTqICYqUVnKs3thJo3Qplg= +golang.org/x/net v0.0.0-20190404232315-eb5bcb51f2a3/go.mod h1:t9HGtf8HONx5eT2rtn7q6eTqICYqUVnKs3thJo3Qplg= +golang.org/x/net v0.0.0-20190501004415-9ce7a6920f09/go.mod h1:t9HGtf8HONx5eT2rtn7q6eTqICYqUVnKs3thJo3Qplg= +golang.org/x/net v0.0.0-20190503192946-f4e77d36d62c/go.mod h1:t9HGtf8HONx5eT2rtn7q6eTqICYqUVnKs3thJo3Qplg= +golang.org/x/net v0.0.0-20190603091049-60506f45cf65/go.mod h1:HSz+uSET+XFnRR8LxR5pz3Of3rY3CfYBVs4xY44aLks= +golang.org/x/net v0.0.0-20190613194153-d28f0bde5980/go.mod h1:z5CRVTTTmAJ677TzLLGU+0bjPO0LkuOLi4/5GtJWs/s= +golang.org/x/net v0.0.0-20190620200207-3b0461eec859/go.mod h1:z5CRVTTTmAJ677TzLLGU+0bjPO0LkuOLi4/5GtJWs/s= +golang.org/x/net v0.0.0-20190724013045-ca1201d0de80/go.mod h1:z5CRVTTTmAJ677TzLLGU+0bjPO0LkuOLi4/5GtJWs/s= +golang.org/x/net v0.0.0-20191209160850-c0dbc17a3553/go.mod h1:z5CRVTTTmAJ677TzLLGU+0bjPO0LkuOLi4/5GtJWs/s= +golang.org/x/net v0.0.0-20200520004742-59133d7f0dd7/go.mod h1:qpuaurCH72eLCgpAm/N6yyVIVM9cpaDIP3A8BGJEC5A= +golang.org/x/net v0.0.0-20200813134508-3edf25e44fcc/go.mod h1:/O7V0waA8r7cgGh81Ro3o1hOxt32SMVPicZroKQ2sZA= +golang.org/x/net v0.0.0-20201021035429-f5854403a974/go.mod h1:sp8m0HH+o8qH0wwXwYZr8TS3Oi6o0r6Gce1SSxlDquU= +golang.org/x/net v0.0.0-20210220033124-5f55cee0dc0d/go.mod h1:m0MpNAwzfU5UDzcl9v0D8zg8gWTRqZa9RBIspLL5mdg= +golang.org/x/net v0.0.0-20210226172049-e18ecbb05110 h1:qWPm9rbaAMKs8Bq/9LRpbMqxWRVUAQwMI9fVrssnTfw= +golang.org/x/net v0.0.0-20210226172049-e18ecbb05110/go.mod h1:m0MpNAwzfU5UDzcl9v0D8zg8gWTRqZa9RBIspLL5mdg= +golang.org/x/oauth2 v0.0.0-20180821212333-d2e6202438be/go.mod h1:N/0e6XlmueqKjAGxoOufVs8QHGRruUQn6yWY3a++T0U= +golang.org/x/oauth2 v0.0.0-20190226205417-e64efc72b421/go.mod h1:gOpvHmFTYa4IltrdGE7lF6nIHvwfUNPOp7c8zoXwtLw= +golang.org/x/oauth2 v0.0.0-20190604053449-0f29369cfe45/go.mod h1:gOpvHmFTYa4IltrdGE7lF6nIHvwfUNPOp7c8zoXwtLw= +golang.org/x/oauth2 v0.0.0-20191202225959-858c2ad4c8b6/go.mod h1:gOpvHmFTYa4IltrdGE7lF6nIHvwfUNPOp7c8zoXwtLw= +golang.org/x/oauth2 v0.0.0-20200107190931-bf48bf16ab8d/go.mod h1:gOpvHmFTYa4IltrdGE7lF6nIHvwfUNPOp7c8zoXwtLw= +golang.org/x/sync v0.0.0-20180314180146-1d60e4601c6f/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20181108010431-42b317875d0f/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20181221193216-37e7f081c4d4/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20190227155943-e225da77a7e6/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20190423024810-112230192c58/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20190911185100-cd5d95a43a6e/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20200317015054-43a5402ce75a/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20201020160332-67f06af15bc9/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sync v0.0.0-20210220032951-036812b2e83c/go.mod h1:RxMgew5VJxzue5/jJTE5uejpjVlOe/izrB70Jof72aM= +golang.org/x/sys v0.0.0-20180830151530-49385e6e1522/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= +golang.org/x/sys v0.0.0-20180905080454-ebe1bf3edb33/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= +golang.org/x/sys v0.0.0-20180909124046-d0be0721c37e/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= +golang.org/x/sys v0.0.0-20181107165924-66b7b1311ac8/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= +golang.org/x/sys v0.0.0-20181116152217-5ac8a444bdc5/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= +golang.org/x/sys v0.0.0-20190215142949-d0b11bdaac8a/go.mod h1:STP8DvDyc/dI5b8T5hshtkjS+E42TnysNCUPdjciGhY= +golang.org/x/sys v0.0.0-20190312061237-fead79001313/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20190412213103-97732733099d/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20190502145724-3ef323f4f1fd/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20190507160741-ecd444e8653b/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20190606165138-5da285871e9c/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20190624142023-c5567b49c5d0/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20190726091711-fc99dfbffb4e/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20190904154756-749cb33beabd/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20191005200804-aed5e4c7ecf9/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20191120155948-bd437916bb0e/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20191204072324-ce4227a45e2e/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20191228213918-04cbcbbfeed8/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20200107162124-548cf772de50/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20200323222414-85ca7c5b95cd/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20200519105757-fe76b779f299/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20200814200057-3d37ad5750ed/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20200930185726-fdedc70b468f/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20201119102817-f84b799fce68/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20210119212857-b64e53b001e4/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20210316164454-77fc1eacc6aa/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20210324051608-47abb6519492/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/sys v0.0.0-20210420205809-ac73e9fd8988 h1:EjgCl+fVlIaPJSori0ikSz3uV0DOHKWOJFpv1sAAhBM= +golang.org/x/sys v0.0.0-20210420205809-ac73e9fd8988/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs= +golang.org/x/term v0.0.0-20201126162022-7de9c90e9dd1 h1:v+OssWQX+hTHEmOBgwxdZxK4zHq3yOs8F9J7mk0PY8E= +golang.org/x/term v0.0.0-20201126162022-7de9c90e9dd1/go.mod h1:bj7SfCRtBDWHUb9snDiAeCFNEtKQo2Wmx5Cou7ajbmo= +golang.org/x/text v0.3.0/go.mod h1:NqM8EUOU14njkJ3fqMW+pc6Ldnwhi/IjpwHt7yyuwOQ= +golang.org/x/text v0.3.1-0.20180807135948-17ff2d5776d2/go.mod h1:NqM8EUOU14njkJ3fqMW+pc6Ldnwhi/IjpwHt7yyuwOQ= +golang.org/x/text v0.3.2/go.mod h1:bEr9sfX3Q8Zfm5fL9x+3itogRgK3+ptLWKqgva+5dAk= +golang.org/x/text v0.3.3/go.mod h1:5Zoc/QRtKVWzQhOtBMvqHzDpF6irO9z98xDceosuGiQ= +golang.org/x/text v0.3.4 h1:0YWbFKbhXG/wIiuHDSKpS0Iy7FSA+u45VtBMfQcFTTc= +golang.org/x/text v0.3.4/go.mod h1:5Zoc/QRtKVWzQhOtBMvqHzDpF6irO9z98xDceosuGiQ= +golang.org/x/time v0.0.0-20181108054448-85acf8d2951c/go.mod h1:tRJNPiyCQ0inRvYxbN9jk5I+vvW/OXSQhTDSoE431IQ= +golang.org/x/time v0.0.0-20190308202827-9d24e82272b4/go.mod h1:tRJNPiyCQ0inRvYxbN9jk5I+vvW/OXSQhTDSoE431IQ= +golang.org/x/time v0.0.0-20201208040808-7e3f01d25324/go.mod h1:tRJNPiyCQ0inRvYxbN9jk5I+vvW/OXSQhTDSoE431IQ= +golang.org/x/tools v0.0.0-20180525024113-a5b4c53f6e8b/go.mod h1:n7NCudcB/nEzxVGmLbDWY5pfWTLqBcC2KZ6jyYvM4mQ= +golang.org/x/tools v0.0.0-20180917221912-90fa682c2a6e/go.mod h1:n7NCudcB/nEzxVGmLbDWY5pfWTLqBcC2KZ6jyYvM4mQ= +golang.org/x/tools v0.0.0-20181030221726-6c7e314b6563/go.mod h1:n7NCudcB/nEzxVGmLbDWY5pfWTLqBcC2KZ6jyYvM4mQ= +golang.org/x/tools v0.0.0-20190114222345-bf090417da8b/go.mod h1:n7NCudcB/nEzxVGmLbDWY5pfWTLqBcC2KZ6jyYvM4mQ= +golang.org/x/tools v0.0.0-20190206041539-40960b6deb8e/go.mod h1:n7NCudcB/nEzxVGmLbDWY5pfWTLqBcC2KZ6jyYvM4mQ= +golang.org/x/tools v0.0.0-20190226205152-f727befe758c/go.mod h1:9Yl7xja0Znq3iFh3HoIrodX9oNMXvdceNzlUR8zjMvY= +golang.org/x/tools v0.0.0-20190311212946-11955173bddd/go.mod h1:LCzVGOaR6xXOjkQ3onu1FJEFr0SW1gC7cKk1uF8kGRs= +golang.org/x/tools v0.0.0-20190312151545-0bb0c0a6e846/go.mod h1:LCzVGOaR6xXOjkQ3onu1FJEFr0SW1gC7cKk1uF8kGRs= +golang.org/x/tools v0.0.0-20190312170243-e65039ee4138/go.mod h1:LCzVGOaR6xXOjkQ3onu1FJEFr0SW1gC7cKk1uF8kGRs= +golang.org/x/tools v0.0.0-20190328211700-ab21143f2384/go.mod h1:LCzVGOaR6xXOjkQ3onu1FJEFr0SW1gC7cKk1uF8kGRs= +golang.org/x/tools v0.0.0-20190425150028-36563e24a262/go.mod h1:RgjU9mgBXZiqYHBnxXauZ1Gv1EHHAz9KjViQ78xBX0Q= +golang.org/x/tools v0.0.0-20190506145303-2d16b83fe98c/go.mod h1:RgjU9mgBXZiqYHBnxXauZ1Gv1EHHAz9KjViQ78xBX0Q= +golang.org/x/tools v0.0.0-20190524140312-2c0ae7006135/go.mod h1:RgjU9mgBXZiqYHBnxXauZ1Gv1EHHAz9KjViQ78xBX0Q= +golang.org/x/tools v0.0.0-20190606124116-d0a3d012864b/go.mod h1:/rFqwRUd4F7ZHNgwSSTFct+R/Kf4OFW1sUzUTQQTgfc= +golang.org/x/tools v0.0.0-20190621195816-6e04913cbbac/go.mod h1:/rFqwRUd4F7ZHNgwSSTFct+R/Kf4OFW1sUzUTQQTgfc= +golang.org/x/tools v0.0.0-20190628153133-6cdbf07be9d0/go.mod h1:/rFqwRUd4F7ZHNgwSSTFct+R/Kf4OFW1sUzUTQQTgfc= +golang.org/x/tools v0.0.0-20190816200558-6889da9d5479/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= +golang.org/x/tools v0.0.0-20190911174233-4f2ddba30aff/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= +golang.org/x/tools v0.0.0-20191012152004-8de300cfc20a/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= +golang.org/x/tools v0.0.0-20191113191852-77e3bb0ad9e7/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= +golang.org/x/tools v0.0.0-20191115202509-3a792d9c32b2/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= +golang.org/x/tools v0.0.0-20191119224855-298f0cb1881e/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= +golang.org/x/tools v0.0.0-20191125144606-a911d9008d1f/go.mod h1:b+2E5dAYhXwXZwtnZ6UAqBI28+e2cm9otk0dWdXHAEo= +golang.org/x/tools v0.0.0-20191216173652-a0e659d51361/go.mod h1:TB2adYChydJhpapKDTa4BR/hXlZSLoq2Wpct/0txZ28= +golang.org/x/tools v0.0.0-20191227053925-7b8e75db28f4/go.mod h1:TB2adYChydJhpapKDTa4BR/hXlZSLoq2Wpct/0txZ28= +golang.org/x/tools v0.0.0-20200108203644-89082a384178/go.mod h1:TB2adYChydJhpapKDTa4BR/hXlZSLoq2Wpct/0txZ28= +golang.org/x/tools v0.1.0/go.mod h1:xkSsbof2nBLbhDlRMhhhyNLN/zl3eTqcnHD5viDpcZ0= +golang.org/x/xerrors v0.0.0-20190717185122-a985d3407aa7/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0= +golang.org/x/xerrors v0.0.0-20191011141410-1b5146add898/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0= +golang.org/x/xerrors v0.0.0-20191204190536-9bdfabe68543/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0= +golang.org/x/xerrors v0.0.0-20200804184101-5ec99f83aff1 h1:go1bK/D/BFZV2I8cIQd1NKEZ+0owSTG1fDTci4IqFcE= +golang.org/x/xerrors v0.0.0-20200804184101-5ec99f83aff1/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0= +gonum.org/v1/gonum v0.0.0-20180816165407-929014505bf4/go.mod h1:Y+Yx5eoAFn32cQvJDxZx5Dpnq+c3wtXuadVZAcxbbBo= +gonum.org/v1/gonum v0.0.0-20181121035319-3f7ecaa7e8ca/go.mod h1:Y+Yx5eoAFn32cQvJDxZx5Dpnq+c3wtXuadVZAcxbbBo= +gonum.org/v1/gonum v0.6.0/go.mod h1:9mxDZsDKxgMAuccQkewq682L+0eCu4dCN2yonUJTCLU= +gonum.org/v1/netlib v0.0.0-20181029234149-ec6d1f5cefe6/go.mod h1:wa6Ws7BG/ESfp6dHfk7C6KdzKA7wR7u/rKwOGE66zvw= +gonum.org/v1/netlib v0.0.0-20190313105609-8cb42192e0e0/go.mod h1:wa6Ws7BG/ESfp6dHfk7C6KdzKA7wR7u/rKwOGE66zvw= +gonum.org/v1/plot v0.0.0-20190515093506-e2840ee46a6b/go.mod h1:Wt8AAjI+ypCyYX3nZBvf6cAIx93T+c/OS2HFAYskSZc= +google.golang.org/api v0.4.0/go.mod h1:8k5glujaEP+g9n7WNsDg8QP6cUVNI86fCNMcbazEtwE= +google.golang.org/api v0.7.0/go.mod h1:WtwebWUNSVBH/HAw79HIFXZNqEvBhG+Ra+ax0hx3E3M= +google.golang.org/api v0.8.0/go.mod h1:o4eAsZoiT+ibD93RtjEohWalFOjRDx6CVaqeizhEnKg= +google.golang.org/api v0.9.0/go.mod h1:o4eAsZoiT+ibD93RtjEohWalFOjRDx6CVaqeizhEnKg= +google.golang.org/api v0.13.0/go.mod h1:iLdEw5Ide6rF15KTC1Kkl0iskquN2gFfn9o9XIsbkAI= +google.golang.org/api v0.14.0/go.mod h1:iLdEw5Ide6rF15KTC1Kkl0iskquN2gFfn9o9XIsbkAI= +google.golang.org/api v0.15.0/go.mod h1:iLdEw5Ide6rF15KTC1Kkl0iskquN2gFfn9o9XIsbkAI= +google.golang.org/appengine v1.1.0/go.mod h1:EbEs0AVv82hx2wNQdGPgUI5lhzA/G0D9YwlJXL52JkM= +google.golang.org/appengine v1.4.0/go.mod h1:xpcJRLb0r/rnEns0DIKYYv+WjYCduHsrkT7/EB5XEv4= +google.golang.org/appengine v1.5.0/go.mod h1:xpcJRLb0r/rnEns0DIKYYv+WjYCduHsrkT7/EB5XEv4= +google.golang.org/appengine v1.6.1/go.mod h1:i06prIuMbXzDqacNJfV5OdTW448YApPu5ww/cMBSeb0= +google.golang.org/appengine v1.6.5/go.mod h1:8WjMMxjGQR8xUklV/ARdw2HLXBOI7O7uCIDZVag1xfc= +google.golang.org/genproto v0.0.0-20180817151627-c66870c02cf8/go.mod h1:JiN7NxoALGmiZfu7CAH4rXhgtRTLTxftemlI0sWmxmc= +google.golang.org/genproto v0.0.0-20190307195333-5fe7a883aa19/go.mod h1:VzzqZJRnGkLBvHegQrXjBqPurQTc5/KpmUdxsrq26oE= +google.golang.org/genproto v0.0.0-20190418145605-e7d98fc518a7/go.mod h1:VzzqZJRnGkLBvHegQrXjBqPurQTc5/KpmUdxsrq26oE= +google.golang.org/genproto v0.0.0-20190425155659-357c62f0e4bb/go.mod h1:VzzqZJRnGkLBvHegQrXjBqPurQTc5/KpmUdxsrq26oE= +google.golang.org/genproto v0.0.0-20190502173448-54afdca5d873/go.mod h1:VzzqZJRnGkLBvHegQrXjBqPurQTc5/KpmUdxsrq26oE= +google.golang.org/genproto v0.0.0-20190716160619-c506a9f90610/go.mod h1:DMBHOl98Agz4BDEuKkezgsaosCRResVns1a3J2ZsMNc= +google.golang.org/genproto v0.0.0-20190801165951-fa694d86fc64/go.mod h1:DMBHOl98Agz4BDEuKkezgsaosCRResVns1a3J2ZsMNc= +google.golang.org/genproto v0.0.0-20190819201941-24fa4b261c55/go.mod h1:DMBHOl98Agz4BDEuKkezgsaosCRResVns1a3J2ZsMNc= +google.golang.org/genproto v0.0.0-20190911173649-1774047e7e51/go.mod h1:IbNlFCBrqXvoKpeg0TB2l7cyZUmoaFKYIwrEpbDKLA8= +google.golang.org/genproto v0.0.0-20191108220845-16a3f7862a1a/go.mod h1:n3cpQtvxv34hfy77yVDNjmbRyujviMdxYliBSkLhpCc= +google.golang.org/genproto v0.0.0-20191115194625-c23dd37a84c9/go.mod h1:n3cpQtvxv34hfy77yVDNjmbRyujviMdxYliBSkLhpCc= +google.golang.org/genproto v0.0.0-20191216164720-4f79533eabd1/go.mod h1:n3cpQtvxv34hfy77yVDNjmbRyujviMdxYliBSkLhpCc= +google.golang.org/genproto v0.0.0-20191230161307-f3c370f40bfb/go.mod h1:n3cpQtvxv34hfy77yVDNjmbRyujviMdxYliBSkLhpCc= +google.golang.org/genproto v0.0.0-20200108215221-bd8f9a0ef82f/go.mod h1:n3cpQtvxv34hfy77yVDNjmbRyujviMdxYliBSkLhpCc= +google.golang.org/grpc v1.19.0/go.mod h1:mqu4LbDTu4XGKhr4mRzUsmM4RtVoemTSY81AxZiDr8c= +google.golang.org/grpc v1.20.1/go.mod h1:10oTOabMzJvdu6/UiuZezV6QK5dSlG84ov/aaiqXj38= +google.golang.org/grpc v1.21.1/go.mod h1:oYelfM1adQP15Ek0mdvEgi9Df8B9CZIaU1084ijfRaM= +google.golang.org/grpc v1.23.0/go.mod h1:Y5yQAOtifL1yxbo5wqy6BxZv8vAUGQwXBOALyacEbxg= +google.golang.org/grpc v1.26.0/go.mod h1:qbnxyOmOxrQa7FizSgH+ReBfzJrCY1pSN7KXBS8abTk= +google.golang.org/protobuf v0.0.0-20200109180630-ec00e32a8dfd/go.mod h1:DFci5gLYBciE7Vtevhsrf46CRTquxDuWsQurQQe4oz8= +google.golang.org/protobuf v0.0.0-20200221191635-4d8936d0db64/go.mod h1:kwYJMbMJ01Woi6D6+Kah6886xMZcty6N08ah7+eCXa0= +google.golang.org/protobuf v0.0.0-20200228230310-ab0ca4ff8a60/go.mod h1:cfTl7dwQJ+fmap5saPgwCLgHXTUD7jkjRqWcaiX5VyM= +google.golang.org/protobuf v1.20.1-0.20200309200217-e05f789c0967/go.mod h1:A+miEFZTKqfCUM6K7xSMQL9OKL/b6hQv+e19PK+JZNE= +google.golang.org/protobuf v1.21.0/go.mod h1:47Nbq4nVaFHyn7ilMalzfO3qCViNmqZ2kzikPIcrTAo= +google.golang.org/protobuf v1.23.0 h1:4MY060fB1DLGMB/7MBTLnwQUY6+F09GEiz6SsrNqyzM= +google.golang.org/protobuf v1.23.0/go.mod h1:EGpADcykh3NcUnDUJcl1+ZksZNG86OlYog2l/sGQquU= +gopkg.in/alecthomas/kingpin.v2 v2.2.6/go.mod h1:FMv+mEhP44yOT+4EoQTLFTRgOQ1FBLkstjWtayDeSgw= +gopkg.in/check.v1 v0.0.0-20161208181325-20d25e280405/go.mod h1:Co6ibVJAznAaIkqp8huTwlJQCZ016jof/cbN4VW5Yz0= +gopkg.in/check.v1 v1.0.0-20180628173108-788fd7840127 h1:qIbj1fsPNlZgppZ+VLlY7N33q108Sa+fhmuc+sWQYwY= +gopkg.in/check.v1 v1.0.0-20180628173108-788fd7840127/go.mod h1:Co6ibVJAznAaIkqp8huTwlJQCZ016jof/cbN4VW5Yz0= +gopkg.in/errgo.v2 v2.1.0/go.mod h1:hNsd1EY+bozCKY1Ytp96fpM3vjJbqLJn88ws8XvfDNI= +gopkg.in/fsnotify.v1 v1.4.7/go.mod h1:Tz8NjZHkW78fSQdbUxIjBTcgA1z1m8ZHf0WmKUhAMys= +gopkg.in/natefinch/npipe.v2 v2.0.0-20160621034901-c1b8fa8bdcce/go.mod h1:5AcXVHNjg+BDxry382+8OKon8SEWiKktQR07RKPsv1c= +gopkg.in/olebedev/go-duktape.v3 v3.0.0-20200619000410-60c24ae608a6/go.mod h1:uAJfkITjFhyEEuUfm7bsmCZRbW5WRq8s9EY8HZ6hCns= +gopkg.in/tomb.v1 v1.0.0-20141024135613-dd632973f1e7 h1:uRGJdciOHaEIrze2W8Q3AKkepLTh2hOroT7a+7czfdQ= +gopkg.in/tomb.v1 v1.0.0-20141024135613-dd632973f1e7/go.mod h1:dt/ZhP58zS4L8KSrWDmTeBkI65Dw0HsyUHuEVlX15mw= +gopkg.in/urfave/cli.v1 v1.20.0 h1:NdAVW6RYxDif9DhDHaAortIu956m2c0v+09AZBPTbE0= +gopkg.in/urfave/cli.v1 v1.20.0/go.mod h1:vuBzUtMdQeixQj8LVd+/98pzhxNGQoyuPBlsXHOQNO0= +gopkg.in/yaml.v2 v2.2.1/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI= +gopkg.in/yaml.v2 v2.2.2/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI= +gopkg.in/yaml.v2 v2.2.3/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI= +gopkg.in/yaml.v2 v2.2.4/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI= +gopkg.in/yaml.v2 v2.2.8/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI= +gopkg.in/yaml.v2 v2.3.0 h1:clyUAQHOM3G0M3f5vQj7LuJrETvjVot3Z5el9nffUtU= +gopkg.in/yaml.v2 v2.3.0/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI= +gopkg.in/yaml.v3 v3.0.0-20200313102051-9f266ea9e77c h1:dUUwHk2QECo/6vqA44rthZ8ie2QXMNeKRTHCNY2nXvo= +gopkg.in/yaml.v3 v3.0.0-20200313102051-9f266ea9e77c/go.mod h1:K4uyk7z7BCEPqu6E+C64Yfv1cQ7kz7rIZviUmN+EgEM= +gotest.tools v2.2.0+incompatible/go.mod h1:DsYFclhRJ6vuDpmuTbkuFWG+y2sxOXAzmJt81HFBacw= +honnef.co/go/tools v0.0.0-20190102054323-c2f93a96b099/go.mod h1:rf3lG4BRIbNafJWhAfAdb/ePZxsR/4RtNHQocxwk9r4= +honnef.co/go/tools v0.0.0-20190106161140-3f1c8253044a/go.mod h1:rf3lG4BRIbNafJWhAfAdb/ePZxsR/4RtNHQocxwk9r4= +honnef.co/go/tools v0.0.0-20190418001031-e561f6794a2a/go.mod h1:rf3lG4BRIbNafJWhAfAdb/ePZxsR/4RtNHQocxwk9r4= +honnef.co/go/tools v0.0.0-20190523083050-ea95bdfd59fc/go.mod h1:rf3lG4BRIbNafJWhAfAdb/ePZxsR/4RtNHQocxwk9r4= +honnef.co/go/tools v0.0.1-2019.2.3/go.mod h1:a3bituU0lyd329TUQxRnasdCoJDkEUEAqEt0JzvZhAg= +honnef.co/go/tools v0.1.3/go.mod h1:NgwopIslSNH47DimFoV78dnkksY2EFtX0ajyb3K/las= +rsc.io/binaryregexp v0.2.0/go.mod h1:qTv7/COck+e2FymRvadv62gMdZztPaShugOCi3I+8D8= +rsc.io/pdf v0.1.1/go.mod h1:n8OzWcQ6Sp37PL01nO98y4iUCRdTGarVfzxY20ICaU4= diff --git a/src/hevm/.envrc b/src/hevm/.envrc deleted file mode 100644 index 0046086cd..000000000 --- a/src/hevm/.envrc +++ /dev/null @@ -1,7 +0,0 @@ -# vim: set ft=sh: - -if has lorri; then - eval "$(lorri direnv)" -else - use nix -fi diff --git a/src/hevm/CHANGELOG.md b/src/hevm/CHANGELOG.md deleted file mode 100644 index 86576da8c..000000000 --- a/src/hevm/CHANGELOG.md +++ /dev/null @@ -1,637 +0,0 @@ -# Changelog - -All notable changes to this project will be documented in this file. - -The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), -and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). - -## Unreleased - -### Added - -- Support for solc 0.8.12 -- Support for solc 0.8.13 -- Support for solc 0.8.14 -- Support for solc 0.8.15 -- Support for solc 0.8.16 -- Support for solc 0.8.17 -- Support for solc 0.8.18 -- Support for solc 0.8.19 - -### Fixed - -- Correctly handle concrete returndata when checking the result of a symbolic test -- Correctly handle reverting branches when checking the result of a symbolic test - -## [0.49.0] - 2021-11-12 - -### Added - -- Support for solc 0.8.10 -- Support for solc 0.8.11 - -### Changed - -- Clearer display for the invalid opcode (`0xfe`) in debug view -- Better error messages when trying to deploy unlinked bytecode -- `bytesX` arguments to `hevm abiencode` are automatically padded - -### Fixed - -- Test contracts with no code (e.g. `abstract` contracts) are now skipped -- Replay data for invariant tests is now displayed in a form that does not cause errors when used with `dapp test --replay` - -## [0.48.1] - 2021-09-08 - -### Added - -- Support for 0.8.4 custom error types in stack traces - -### Changed - -- Contract feching happens synchronously again. -- Invariants checked before calling methods from targetContracts. - -### Fixed - -- The block gas limit and basefee are now correctly fetched when running tests via rpc - -## 0.48.0 - 2021-08-03 - -### Changed - -- Updated to London hard fork! -- The configuration variable `DAPP_TEST_BALANCE_CREATE` has been renamed to `DAPP_TEST_BALANCE` -- Default `smttimeout` has been increased to 1 minute. -- A new flag has been added to hevm (`--ask-smt-iterations`) that controls the number of iterations - at which the symbolic execution engine will stop eager evaluation and begin to query the smt - solver whether a given branch is reachable or not. -- Contract fetching now happens asynchronously. -- Fixed no contract definition crashes -- Removed NoSuchContract failures - -## 0.47.0 - 2021-07-01 - -### Added - -- A new test runner for checking invariants against random reachable contract states. -- `hevm symbolic` can search for solc 0.8 style assertion violations, and a new `--assertions` flag - has been added allowing users to customize which assertions should be reported -- A new cheatcode `ffi(string[])` that executes an arbitrary command in the system shell - -### Changed - -- Z3 is once again the default smt solver -- Updated nixpkgs to the `21.05` channel - -### Fixed - -- Sourcemaps for contracts containing `immutable` are now shown in the debug view. - -## 0.46.0 - 2021-04-29 - -### Added - -- Updated to Berlin! Conformant with GeneralStateTests at commit hash `644967e345bbc6642fab613e1b1737abbe131f78`. - -### Fixed - -- ADDMOD and MULMOD by zero yields zero. -- Address calculation for newly created contracts. -- Accomodated for the notorious "anomolies on the main network" (see yellow paper Appendix K for trivia) -- A hevm crash when debugging a SELFDESTRUCT contract. - -## 0.45.0 - 2021-03-22 - -### Added - -- Two new cheatcodes were added: `sign(uint sk, bytes message)` and `addr(uint sk)`. Taken together - these should allow for much more ergonomic testing of code that handles signed messages. -- Symbolic execution can deal with partially symbolic bytecode, allowing for symbolic constructor arguments to be given in tests. - -### Fixed - -- Fixed a bug in the abiencoding. -- Fixed the range being generated by ints. -- `hevm flatten` combines the SPDX license identifiers of all source files. - -### Changed - -- updated `nixpkgs` to the `20.09` channel -- Arbitrary instance of AbiType can no longer generate a tuple - -## 0.44.1 - 2020-02-02 - -### Changed - -- hevm cheatcodes now accept symbolic arguments, allowing e.g. symbolic jumps in time in unit tests -- More efficient arithmetic overflow checks by translating queries to a more [intelligent form](www.microsoft.com/en-us/research/wp-content/uploads/2016/02/z3prefix.pdf). - -## 0.44.0 - 2020-01-26 - -### Added - -- `hevm` now accepts solidity json output built via `--standard-json` as - well as `--combined-json`. -- addresses in the trace output are prefixed with `ContractName@0x...` - if there is a corresponding contract and `@0x...` otherwise. - -### Fixed - -- Symbolic execution now generates calldata arguments restricted to the proper ranges, - following the semantics of fuzzing. -- If the `--address` flag is present in `hevm exec` or `hevm symbolic`, - it overrides the contract address at which a contract will be created. -- Address pretty printing -- Updated sbv to `8.9.5` to fix "non-const in array declaration" cvc4 issue with ds-test. - -### Changed - -- Use cvc4 as default smt solver - -## 0.43.2 - 2020-12-10 - -### Changed - -- The default smttimeout has been increased from 20s to 30s - -## 0.43.1 - 2020-12-10 - -### Changed - -- Counterexamples from symbolic tests now show clearer failure reasons - -### Fixed - -- Symbolic tests now work with RPC -- Branch selection is working again in the interactive debugger - -## 0.43.0 - 2020-11-29 - -### Added - -- A `--show-tree` option to `hevm symbolic` which prints the execution tree explored. -- Some symbolic terms are displayed with richer semantic information, instead of the black box ``. -- `hevm dapp-test` now supports symbolic execution of test methods that are prefixed with `prove` or `proveFail` -- The `hevm interactive` alias has been removed, as it is equivalent to `hevm dapp-test --debug` -- `hevm dapp-test --match` now matches on contract name and file path, as well as test name -- Step through the callstack in debug mode using the arrow keys - -### Changed - -- `dapp-test` trace output now detects ds-note events and shows `LogNote` -- create addresses are shown with `@
` in the trace -- `DSTest.setUp()` is only run if it exists, rather than failing -- support new ds-test `log_named_x(string, x)` (previously bytes32 keys) -- return arguments are fully displayed in the trace (previously only a single word) -- return/revert trace will now show the correct source position - -## 0.42.0 - 2020-10-31 - -### Changed - -- z3 updated to 4.8.8 -- optimize SMT queries -- More useful trace output for unknown calls -- Default to on chain values for `coinbase`, `timestamp`, `difficulty`, `blocknumber` when rpc is provided -- Perform tx initialization (gas payment, value transfer) in `hevm exec`, `hevm symbolic` and `hevm dapp-test`. - -### Added - -- TTY commands `P` and `c-p` for taking larger steps backwards in the debuger. -- `--cache` flag for `dapp-test`, `exec`, `symbolic`, `interactive`, - enabling caching of contracts received by rpc. -- `load(address,bytes32)` cheat code allowing storage reads from arbitrary contracts. - -## 0.41.0 - 2020-08-19 - -### Changed - -- Switched to [PVP](https://github.com/haskell/pvp/blob/master/pvp-faq.md) for version control, starting now at `0.41.0` (MAJOR.MAJOR.MINOR). -- z3 updated to 4.8.7 -- Generate more interesting values in property based testing, - and implement proper shrinking for all abi values. -- Fixed soundness bug when using KECCAK or SHA256 opcode/precompile -- Fixed an issue in debug mode where backstepping could cause path information to be forgotten -- Ensure that pathconditions are consistent when branching, and end the execution with VMFailure: DeadPath if this is not the case -- Fixed a soundness bug where nonzero jumpconditions were assumed to equal one. -- default `--smttimeout` changed from unlimited to 20 seconds -- `hevm symbolic --debug` now respects `--max-iterations` - -### Added - -- `hevm exec --trace` flag to dump a trace -- Faster backstepping in interactive mode by saving multiple snapshot states. -- Support for symbolic storage for multiple contracts - -## 0.40 - 2020-07-22 - -- hevm is now capable of symbolic execution! - -### Changed - -As a result, the types of several registers of the EVM have changed to admit symbolic values as well as concrete ones. - -- state.stack: `Word` -> `SymWord`. -- state.memory: `ByteString` -> `[SWord 8]`. -- state.callvalue: `W256` -> `SymWord`. -- state.caller: `Addr` -> `SAddr`. -- state.returndata: `ByteString` -> `[SWord 8]`. -- state.calldata: `ByteString` -> `([SWord 8], (SWord 32))`. The first element is a list of symbolic bytes, the second is the length of calldata. We have `fst calldata !! i .== 0` for all `snd calldata < i`. - -- tx.value: `W256` -> `SymWord`. - -- contract.storage: `Map Word Word` -> `Storage`, defined as: - -```hs -data Storage - = Concrete (Map Word SymWord) - | Symbolic (SArray (WordN 256) (WordN 256)) - deriving (Show) -``` - -### Added - -New cli commands: - -- `hevm symbolic`: search for assertion violations, or step through a symbolic execution in debug mode. -- `hevm equivalence`: compare two programs for equivalence. - -See the README for details on usage. - -The new module `EVM.SymExec` exposes several library functions dealing with symbolic execution. -In particular, - -- `SymExec.interpret`: implements an operational monad script similar to `TTY.interpret` and `Stepper.interpret`, but returns a list of final VM states rather than a single VM. -- `SymExec.verify`: takes a prestate and a postcondition, symbolically executes the prestate and checks that all final states matches the postcondition. - -### Removed - -The concrete versions of a lot of arithmetic operations, replaced with their more general symbolic counterpart. - -## 0.39 - 2020-07-13 - -- Exposes abi encoding to cli -- Added cheat code `hevm.store(address a, bytes32 location, bytes32 value)` -- Removes `ExecMode`, always running as `ExecuteAsBlockchainTest`. This means that `hevm exec` now finalizes transactions as well. -- `--code` is now entirely optional. Not supplying it returns an empty contract, or whatever is stored in `--state`. - -## 0.38 - 2020-04-23 - -- Exposes metadata stripping of bytecode to the cli: `hevm strip-metadata --code X`. [357](https://github.com/dapphub/dapptools/pull/357). -- Fixes a bug in the srcmap parsing introduced in 0.37 [356](https://github.com/dapphub/dapptools/pull/356). -- Fixes a bug in the abi-encoding of `bytes` with size > 32[358](https://github.com/dapphub/dapptools/pull/358). - -## 0.37 - 2020-03-24 - -- Sourcemap parser now admits `solc-0.6.0` compiled `.sol.json` files. - -## 0.36 - 2020-01-07 - -- Implement Istanbul support [318](https://github.com/dapphub/dapptools/pull/318) -- Fix a bug introduced in [280](https://github.com/dapphub/dapptools/pull/280) of rlp encoding of transactions and sender address [320](https://github.com/dapphub/dapptools/pull/320/). -- Make InvalidTx a fatal error for vm tests and ci. -- Suport property based testing in unit tests. [313](https://github.com/dapphub/dapptools/pull/313) Arguments to test functions are randomly generated based on the function abi. Fuzz tests are not present in the graphical debugger. -- Added flags `--replay` and `--fuzz-run` to `hevm dapp-test`, allowing for particular fuzz run cases to be rerun, or for configuration of how many fuzz tests are run. -- Correct gas readouts for unit tests -- Prevent crash when trying to jump to next source code point if source code is missing - -## 0.35 - 2019-11-02 - -- Merkle Patricia trie support [280](https://github.com/dapphub/dapptools/pull/280) -- RLP encoding and decoding functions [280](https://github.com/dapphub/dapptools/pull/280) -- Extended support for Solidity ABI encoding [259](https://github.com/dapphub/dapptools/pull/259) -- Bug fixes surrounding unit tests and gas accounting (https://github.com/dapphub/dapptools/commit/574ef401d3e744f2dcf994da056810cf69ef84fe, https://github.com/dapphub/dapptools/commit/5257574dd9df14edc29410786b75e9fb9c59069f) - -## 0.34 - 2019-08-28 - -- handle new solc bzzr metadata in codehash for source map -- show VM hex outputs as hexadecimal -- rpc defaults to latest block -- `hevm interactive`: -- fix rpc fetch -- scrollable memory pane -- Fix regression in VMTest compliance. -- `hevm exec` ergonomics: -- Allow code/calldata prefixed with 0x -- create transactions with specific caller nonce -- interactive help pane -- memory pane scrolling - -## 0.33 - 2019-08-06 - -- Full compliance with the [General State Tests][245] (with the - BlockchainTest format), using the Yellow and Jello papers as - reference, for Constantinople Fix (aka Petersburg). Including: -- full precompile support -- correct substate accounting, including touched accounts, - selfdestructs and refunds -- memory read/write semantics -- many gas cost corrections -- Show more information for non solc bytecode in interactive view - (trace and storage) -- Help text for all cli options -- Enable `--debug` flag in `hevm dapp-test` - -[245]: https://github.com/dapphub/dapptools/pull/245 - -## 0.32 - 2019-06-14 - -- Fix dapp-test [nonce initialisation bug][224] - -[224]: https://github.com/dapphub/dapptools/pull/224 - -## 0.31 - 2019-05-29 - -- Precompiles: SHA256, RIPEMD, IDENTITY, MODEXP, ECADD, ECMUL, - ECPAIRING, MODEXP -- Show the hevm version with `hevm version` -- Interactive mode: -- no longer exits on reaching halt -- new shortcuts: 'a' / 'e' for start / end -- allow returning to test picker screen -- Exact integer formatting in dapp-test and tty - -## 0.30 - 2019-05-09 - -- Adjustable verbosity level for `dapp-test` with `--verbose={0,1,2}` -- Working stack build - -## 0.29 - 2019-04-03 - -- Significant jump in compliance with client tests -- Add support for running GeneralStateTests - -## 0.28 - 2019-03-22 - -- Fix delegatecall gas metering, as reported in - https://github.com/dapphub/dapptools/issues/34 - -## 0.27 - 2019-02-06 - -- Fix [hevm flatten issue](https://github.com/dapphub/dapptools/issues/127) - related to SemVer ranges in Solidity version pragmas - -## 0.26 - 2019-02-05 - -- Format Solidity Error(string) messages in trace - -## 0.25 - 2019-02-04 - -- Add SHL, SHR and SAR opcodes - -## 0.24 - 2019-01-23 - -- Fix STATICCALL for precompiled contracts -- Assume Solidity 0.5.2 in tests - -## 0.23 - 2018-12-12 - -- Show passing test traces with --verbose flag - -## 0.22 - 2018-11-13 - -- Simple memory view in TTY - -## 0.21 - 2018-10-29 - -- Fix Hackage package by including C header files for ethjet - -## 0.20 - 2018-10-27 - -- Parse constructor inputs from Solidity AST - -## 0.19 - 2018-10-09 - -- Enable experimental 'cheat' address, allowing for modification of the - EVM environment from within the tests. Currently just the block - timestamp can be adjusted. - -## 0.18 - 2018-10-09 - -- Fix [duplicate address bug](https://github.com/dapphub/dapptools/issues/70) - -## 0.17 - 2018-10-05 - -- Semigroup/Monoid fix - -## 0.16 - 2018-09-19 - -- Move ethjet into hevm - -## [0.15] - 2018-05-09 - -- Fix SDIV/SMOD definitions for extreme case - -## [0.14.1] - 2018-04-17 - -- Improve PC display in TTY - -## [0.14] - 2018-03-08 - -- Implement STATICCALL - -## [0.13] - 2018-02-28 - -- Require specific block number for RPC debugging -- Implement RETURNDATACOPY and RETURNDATASIZE -- Fix bug where created contracts didn't get their balance - -## [0.12.3] - 2017-12-19 - -- More useful RPC debugging because we strip the entire BZZR metadata - -## [0.12.2] - 2017-12-17 - -- Experimental new ecrecover implementation via libethjet -- Correct error checking for setUp() invocations - -## [0.12.1] - 2017-11-28 - -- Test name regex matching via --match -- Fixed source map parsing bug when used with solc --optimize -- TTY: fix a padding-related display glitch - -## [0.12] - 2017-11-14 - -- Use 13 different environment variables to control block parameters - for unit testing, e.g. block number, timestamp, initial balance, etc. - - Full list: - - - `DAPP_TEST_ADDRESS` - - `DAPP_TEST_CALLER` - - `DAPP_TEST_ORIGIN` - - `DAPP_TEST_GAS_CREATE` - - `DAPP_TEST_GAS_CALL` - - `DAPP_TEST_BALANCE_CREATE` - - `DAPP_TEST_BALANCE_CALL` - - `DAPP_TEST_COINBASE` - - `DAPP_TEST_NUMBER` - - `DAPP_TEST_TIMESTAMP` - - `DAPP_TEST_GAS_LIMIT` - - `DAPP_TEST_GAS_PRICE` - - `DAPP_TEST_DIFFICULTY` - -## [0.11.5] - 2017-11-14 - -- Use --state with --exec --debug - -## [0.11.4] - 2017-11-12 - -- Fix bug when unit test contract has creations in constructor - -## [0.11.3] - 2017-11-08 - -- Fix array support in ABI module - -## [0.11.2] - 2017-11-04 - -- TTY: show a help bar with key bindings at the bottom - -## [0.11.1] - 2017-11-02 - -- TTY: fix a display glitch -- TTY: improve display of ABI hashes on the stack - -## [0.11] - 2017-10-31 - -- Add "hevm flatten" for Etherscan-ish source code concatenation -- Simplify code by removing concrete/symbolic machine abstraction - -## [0.10.9] - 2017-10-23 - -- Fix bugs in ABI formatting - -## [0.10.7] - 2017-10-19 - -- Fix library linking bug -- Fix gas consumption of DELEGATECALL -- Better error tracing -- Experimental "contract browser" (stupid list of addresses) - -## [0.10.6] - 2017-10-19 - -- Enable library linking for unit tests and debugger -- Use the same default gas/balance values as `ethrun` - -## [0.10.5] - 2017-10-17 - -- Better trace output including arguments and return values -- Proof of concept coverage analysis via `dapp-test --coverage` - -## [0.10] - 2017-10-10 - -- Enable new trace output by default for failing tests -- Exit with failure code from test runner when tests fail -- More fixes to improve Ethereum test suite compliance - -## [0.9.5] - 2017-10-06 - -- Prototype of new trace output with `hevm dapp-test --verbose` -- Nicer trace tree in the TTY debugger -- Many fixes to improve Ethereum test suite compliance - -## [0.9] - 2017-09-29 - -- Integrates with live chains via RPC (read-only) -- Exposes a special contract address with test-related functionality (time warp) - -## [0.8.5] - 2017-09-22 - -- Renames `hevm` from its maiden name `hsevm` :sparkles: - -## [0.8] - 2017-09-21 - -- Implements gas metering (Metropolis rules by default) -- Shows gas counter in the terminal interface -- Enables debugger for consensus test executions -- Consensus test runner script with HTML reporting -- Passes 564 of the `VMTests`; fails 115 (see [0.8 test report]) -- Command line options for specifying initial gas amounts and balances -- Improved TTY UI layout - -## [0.7] - 2017-09-07 - -- Can save and load contract states to disk using a Git-backed store (only `--exec`) -- Can debug raw EVM bytecode using `exec --debug` -- Fixes `exec --value` -- Has smarter defaults for command line when running tests or debugging -- Fixes bug with `MSIZE` in `CALL` context - -## [0.6.5] - 2017-09-01 - -- Fixes `exec` with regards to exit codes and error messages - -## [0.6.1] - 2017-08-03 - -- TTY: Adds command `C-n` in TTY for "stepping over" - -## [0.6] - 2017-08-03 - -- TTY: Adds second line to stack entries with humanized formatting -- TTY: Gets rid of the separate log pane in favor of a unified trace pane - -## [0.5] - 2017-08-02 - -- TTY: Adds `p` command for stepping backwards -- Adds ability to track origins of stack and heap words -- Tracks Keccak preimage for words that come from the `SHA3` instruction - -## [0.4] - 2017-07-31 - -- Parallelizes unit test runner -- Improves speed by changing representation of memory -- Internal refactoring for future support of symbolic execution -- Adds logs to the trace pane - -## [0.3.2] - 2017-06-17 - -- Adds `REVERT` opcode -- Sets `TIMESTAMP` value to `1` in unit tests - -## [0.3.0] - 2017-06-14 - -- Reverts contract state after `CALL` fails -- Improves test runner console output - -## [0.2.0] - 2017-06-13 - -- Fixes bug in `CALL` - -## [0.1.0.1] - 2017-03-31 - -- Highlights Solidity exactly on character level -- Adds `N` command for stepping by Solidity source position instead of by opcode - -## 0.1.0.0 - 2017-03-29 - -- First release - -[0.8 test report]: https://hydra.dapp.tools/build/135/download/1/index.html -[0.12]: https://github.com/dapphub/hevm/compare/0.11.5...0.12 -[0.11.5]: https://github.com/dapphub/hevm/compare/0.11.4...0.11.5 -[0.11.4]: https://github.com/dapphub/hevm/compare/0.11.3...0.11.4 -[0.11.3]: https://github.com/dapphub/hevm/compare/0.11.2...0.11.3 -[0.11.2]: https://github.com/dapphub/hevm/compare/0.11.1...0.11.2 -[0.11.1]: https://github.com/dapphub/hevm/compare/0.11...0.11.1 -[0.11]: https://github.com/dapphub/hevm/compare/0.10.9...0.11 -[0.10.9]: https://github.com/dapphub/hevm/compare/0.10.7...0.10.9 -[0.10.7]: https://github.com/dapphub/hevm/compare/0.10.6...0.10.7 -[0.10.6]: https://github.com/dapphub/hevm/compare/0.10.5...0.10.6 -[0.10.5]: https://github.com/dapphub/hevm/compare/0.10...0.10.5 -[0.10]: https://github.com/dapphub/hevm/compare/0.9.5...0.10 -[0.9.5]: https://github.com/dapphub/hevm/compare/0.9...0.9.5 -[0.9]: https://github.com/dapphub/hevm/compare/v0.8.5...v0.9 -[0.8.5]: https://github.com/dapphub/hevm/compare/v0.8...v0.8.5 -[0.8]: https://github.com/dapphub/hevm/compare/v0.7...v0.8 -[0.7]: https://github.com/dapphub/hevm/compare/v0.6.5...v0.7 -[0.6.5]: https://github.com/dapphub/hevm/compare/v0.6.1...v0.6.5 -[0.6.1]: https://github.com/dapphub/hevm/compare/v0.6...v0.6.1 -[0.6]: https://github.com/dapphub/hevm/compare/v0.5...v0.6 -[0.5]: https://github.com/dapphub/hevm/compare/v0.4...v0.5 -[0.4]: https://github.com/dapphub/hevm/compare/v0.3.2...v0.4 -[0.3.2]: https://github.com/dapphub/hevm/compare/v0.3.0...v0.3.2 -[0.3.0]: https://github.com/dapphub/hevm/compare/v0.2.0...v0.3.0 -[0.2.0]: https://github.com/dapphub/hevm/compare/v0.1.0.1...v0.2.0 -[0.1.0.1]: https://github.com/dapphub/hevm/compare/v0.1.0.0...v0.1.0.1 diff --git a/src/hevm/COPYING b/src/hevm/COPYING deleted file mode 100644 index dba13ed2d..000000000 --- a/src/hevm/COPYING +++ /dev/null @@ -1,661 +0,0 @@ - GNU AFFERO GENERAL PUBLIC LICENSE - Version 3, 19 November 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU Affero General Public License is a free, copyleft license for -software and other kinds of works, specifically designed to ensure -cooperation with the community in the case of network server software. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -our General Public Licenses are intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - Developers that use our General Public Licenses protect your rights -with two steps: (1) assert copyright on the software, and (2) offer -you this License which gives you legal permission to copy, distribute -and/or modify the software. - - A secondary benefit of defending all users' freedom is that -improvements made in alternate versions of the program, if they -receive widespread use, become available for other developers to -incorporate. Many developers of free software are heartened and -encouraged by the resulting cooperation. However, in the case of -software used on network servers, this result may fail to come about. -The GNU General Public License permits making a modified version and -letting the public access it on a server without ever releasing its -source code to the public. - - The GNU Affero General Public License is designed specifically to -ensure that, in such cases, the modified source code becomes available -to the community. It requires the operator of a network server to -provide the source code of the modified version running there to the -users of that server. Therefore, public use of a modified version, on -a publicly accessible server, gives the public access to the source -code of the modified version. - - An older license, called the Affero General Public License and -published by Affero, was designed to accomplish similar goals. This is -a different license, not a version of the Affero GPL, but Affero has -released a new version of the Affero GPL which permits relicensing under -this license. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU Affero General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Remote Network Interaction; Use with the GNU General Public License. - - Notwithstanding any other provision of this License, if you modify the -Program, your modified version must prominently offer all users -interacting with it remotely through a computer network (if your version -supports such interaction) an opportunity to receive the Corresponding -Source of your version by providing access to the Corresponding Source -from a network server at no charge, through some standard or customary -means of facilitating copying of software. This Corresponding Source -shall include the Corresponding Source for any work covered by version 3 -of the GNU General Public License that is incorporated pursuant to the -following paragraph. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the work with which it is combined will remain governed by version -3 of the GNU General Public License. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU Affero General Public License from time to time. Such new versions -will be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU Affero General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU Affero General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU Affero General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Affero General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Affero General Public License for more details. - - You should have received a copy of the GNU Affero General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If your software can interact with users remotely through a computer -network, you should also make sure that it provides a way for users to -get its source. For example, if your program is a web application, its -interface could display a "Source" link that leads users to an archive -of the code. There are many ways you could offer source, and different -solutions will be better for different programs; see section 13 for the -specific requirements. - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU AGPL, see -. diff --git a/src/hevm/Dockerfile b/src/hevm/Dockerfile deleted file mode 100644 index 87bc3871b..000000000 --- a/src/hevm/Dockerfile +++ /dev/null @@ -1,17 +0,0 @@ -FROM mitchty/alpine-ghc:large -ADD https://github.com/lalyos/docker-upx/releases/download/v3.91/upx /bin/upx -RUN chmod +x /bin/upx -RUN sed -i -e 's/v3\.5/v3.6/g' /etc/apk/repositories -RUN apk add --update bzip2-dev readline-dev readline-static \ -&& ln -s /usr/lib/libncursesw.so.6.0 /usr/lib/libncurses.so \ -&& ln -s /usr/lib/libncursesw.so.6.0 /usr/lib/libncursesw.so -WORKDIR /src -ADD hevm.cabal /src/ -RUN cabal update && cabal install happy && cabal install --only-dependencies --disable-executable-dynamic -ADD . /src -RUN apk add --update ncurses-static \ -&& ln -s /usr/lib/libncursesw.a /usr/lib/libncurses.a \ -&& cabal configure --disable-executable-dynamic --ghc-option=-optl-static --ghc-option=-optl-pthread \ -&& cabal build \ -&& cp dist/build/hevm/hevm /bin/hevm -RUN upx /bin/hevm diff --git a/src/hevm/Makefile b/src/hevm/Makefile deleted file mode 100644 index 7f90f8837..000000000 --- a/src/hevm/Makefile +++ /dev/null @@ -1,17 +0,0 @@ -all: build - -.configured: shell.nix - nix-shell --command 'cabal new-configure --enable-tests' --pure - touch .configured -build: .configured - nix-shell --command 'cabal new-build' --pure -repl: .configured - nix-shell --command 'cabal new-repl lib:hevm' --pure -tests: .configured - nix-shell --command 'cabal new-test' --pure - -PORT ?= 8001 -BROWSER ?= chromium -hoogle-server:; nix-shell --run 'hoogle server --local -p $(PORT)' - -.PHONY: all build repl diff --git a/src/hevm/README.md b/src/hevm/README.md deleted file mode 100644 index 97a18d450..000000000 --- a/src/hevm/README.md +++ /dev/null @@ -1,351 +0,0 @@ -# hevm [![Build Status](https://travis-ci.com/dapphub/dapptools.svg?branch=master)](https://travis-ci.com/dapphub/dapptools) - -The `hevm` project is an implementation of the Ethereum virtual machine (EVM) made specifically for symbolic execution, unit testing and debugging of smart contracts. It is developed by [DappHub](https://github.com/dapphub) and integrates especially well with the [`dapp` tool suite](https://github.com/dapphub/dapp). The `hevm` command line program can symbolically execute smart contracts, run unit tests, interactively debug contracts while showing the Solidity source, or run arbitrary EVM code. Computations can be performed using local state set up in a `dapp` testing harness, or fetched on demand from live networks using `rpc` calls. - -### Usage - -Note: some `hevm` commands (`dapp-test`) assume the use of the `ds-test` framework for Solidity unit tests and the [`dapp` tool suite](https://github.com/dapphub/dapptools/tree/master/src/dapp), while others (`exec`, `symbolic`, ...) are available as standalone commands. - -### Commands - - hevm -- Ethereum evaluator - - Usage: hevm [] - or: hevm --help - - Commands: - - symbolic Execute symbolically, exploring all possible execution paths - exec Execute a given program with specified env & calldata - equivalence Prove equivalence between two programs using symbolic execution - dapp-test Run unit tests - - bc-test Run an Ethereum Blockchain/GeneralState test - merkle-test Run a merkle test file and ensure the root matches - compliance Run Blockchain compliance report - - emacs Emacs console - version Show hevm version - flatten Concat all dependencies for a given source file - rlp Decode a RLP encoded bytestring - strip-metadata Remove metadata from contract code bytestring - -### Interactive debugger key bindings - -- `Esc`: exit debugger -- `a`: step to start -- `e`: step to end -- `n`: step forwards by one instruction -- `p`: step backwards by one instruction -- `0`: choose the branch which does not jump -- `1`: choose the branch which does jump -- `N`: step to the next source position -- `P`: step previous source position -- `C-n`: step to the next source position and don't enter `CALL` or `CREATE` -- `C-p`: step previous source position without entering -- `m`: toggle memory view -- `Down` : step to next entry in the callstack / Scroll memory pane\n" <> -- `Up` : step to previous entry in the callstack / Scroll memory pane\n" <> -- `h`: show key-binding help - -### `hevm symbolic` - -```sh -Usage: hevm symbolic [--code TEXT] [--calldata TEXT] [--address ADDR] - [--caller ADDR] [--origin ADDR] [--coinbase ADDR] - [--value W256] [--nonce W256] [--gas W256] [--number W256] - [--timestamp W256] [--gaslimit W256] [--gasprice W256] - [--create] [--maxcodesize W256] [--difficulty W256] - [--chainid W256] [--rpc TEXT] [--block W256] - [--state STRING] [--cache STRING] [--json-file STRING] - [--dapp-root STRING] [--storage-model STORAGEMODEL] - [--sig TEXT] [--arg STRING]... [--debug] [--get-models] - [--show-tree] [--smttimeout INTEGER] - [--max-iterations INTEGER] [--solver TEXT] [--smtdebug] - [--assertions [WORD256]] [--ask-smt-iterations INTEGER] - -Available options: - -h,--help Show this help text - --code TEXT Program bytecode - --calldata TEXT Tx: calldata - --address ADDR Tx: address - --caller ADDR Tx: caller - --origin ADDR Tx: origin - --coinbase ADDR Block: coinbase - --value W256 Tx: Eth amount - --nonce W256 Nonce of origin - --gas W256 Tx: gas amount - --number W256 Block: number - --timestamp W256 Block: timestamp - --gaslimit W256 Tx: gas limit - --gasprice W256 Tx: gas price - --create Tx: creation - --maxcodesize W256 Block: max code size - --difficulty W256 Block: difficulty - --chainid W256 Env: chainId - --rpc TEXT Fetch state from a remote node - --block W256 Block state is be fetched from - --state STRING Path to state repository - --cache STRING Path to rpc cache repository - --json-file STRING Filename or path to dapp build output (default: - out/*.solc.json) - --dapp-root STRING Path to dapp project root directory (default: . ) - --storage-model STORAGEMODEL - Select storage model: ConcreteS, SymbolicS (default) - or InitialS - --sig TEXT Signature of types to decode / encode - --arg STRING Values to encode - --debug Run interactively - --get-models Print example testcase for each execution path - --show-tree Print branches explored in tree view - --smttimeout INTEGER Timeout given to SMT solver in milliseconds (default: - 60000) - --max-iterations INTEGER Number of times we may revisit a particular branching - point - --solver TEXT Used SMT solver: z3 (default) or cvc4 - --smtdebug Print smt queries sent to the solver - --assertions [WORD256] Comma seperated list of solc panic codes to check for - (default: everything except arithmetic overflow) - --ask-smt-iterations INTEGER - Number of times we may revisit a particular branching - point before we consult the smt solver to check - reachability (default: 5) -``` - -Run a symbolic execution against the given parameters, searching for assertion violations. - -Counterexamples will be returned for any reachable assertion violations. Where an assertion -violation is defined as either an execution of the invalid opcode (`0xfe`), or a revert with a -message of the form `abi.encodeWithSelector('Panic(uint256)', errCode)` with `errCode` being one of -the predefined solc assertion codes defined -[here](https://docs.soliditylang.org/en/latest/control-structures.html#panic-via-assert-and-error-via-require). - -By default hevm ignores assertion violations that result from arithmetic overflow (`Panic(0x11)`), -although this behaviour can be customised via the `--assertions` flag. For example, the following -will return counterexmaples for arithmetic overflow (`0x11`) and user defined assertions (`0x01`): - -``` -hevm symbolic --code $CODE --assertions '[0x01, 0x11]' -``` - -`--debug` enters an interactive debugger where the user can navigate the full execution space. - -The default value for `calldata` and `caller` are symbolic values, but can be specialized to concrete functions with their corresponding flags. - -One can also specialize specific arguments to a function signature, while leaving others abstract. -If `--sig` is given, calldata is assumed to be of the form suggested by the function signature. With this flag, specific arguments can be instantiated to concrete values via the `--arg` flag. - -This is best illustrated through a few examples: - -Calldata specialized to the bytestring `0xa9059cbb` followed by 64 symbolic bytes: - -```sh -hevm symbolic --sig "transfer(address,uint256)" --code $(" --arg 0 --code $( -#include "blake2.h" - -#define ROTR64(x, y) (((x) >> (y)) ^ ((x) << (64 - (y)))) - -#define B2B_G(a, b, c, d, x, y) \ - v[a] = v[a] + v[b] + x; \ - v[d] = ROTR64(v[d] ^ v[a], 32); \ - v[c] = v[c] + v[d]; \ - v[b] = ROTR64(v[b] ^ v[c], 24); \ - v[a] = v[a] + v[b] + y; \ - v[d] = ROTR64(v[d] ^ v[a], 16); \ - v[c] = v[c] + v[d]; \ - v[b] = ROTR64(v[b] ^ v[c], 63); - -static const uint64_t blake2b_iv[8] = { - 0x6A09E667F3BCC908, 0xBB67AE8584CAA73B, - 0x3C6EF372FE94F82B, 0xA54FF53A5F1D36F1, - 0x510E527FADE682D1, 0x9B05688C2B3E6C1F, - 0x1F83D9ABFB41BD6B, 0x5BE0CD19137E2179 -}; - -static const uint8_t sigma[10][16] = { - { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 }, - { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 }, - { 11, 8, 12, 0, 5, 2, 15, 13, 10, 14, 3, 6, 7, 1, 9, 4 }, - { 7, 9, 3, 1, 13, 12, 11, 14, 2, 6, 5, 10, 4, 0, 15, 8 }, - { 9, 0, 5, 7, 2, 4, 10, 15, 14, 1, 11, 12, 6, 8, 3, 13 }, - { 2, 12, 6, 10, 0, 11, 8, 3, 4, 13, 7, 5, 15, 14, 1, 9 }, - { 12, 5, 1, 15, 14, 13, 4, 10, 0, 7, 6, 3, 9, 2, 8, 11 }, - { 13, 11, 7, 14, 12, 1, 3, 9, 5, 0, 15, 4, 8, 6, 2, 10 }, - { 6, 15, 14, 9, 11, 3, 0, 8, 12, 2, 13, 7, 1, 4, 10, 5 }, - { 10, 2, 8, 4, 7, 6, 1, 5, 15, 11, 9, 14, 3, 12, 13, 0 } -}; - -void blake2b_compress(uint64_t *h, uint64_t *m, uint64_t *t, char f, uint32_t rounds) { - uint32_t i; - uint64_t v[16]; - - for (i = 0; i < 8; i++) { - v[i] = h[i]; - v[i+8] = blake2b_iv[i]; - } - - v[12] ^= t[0]; - v[13] ^= t[1]; - - if (f) v[14] = ~v[14]; - - int index; - for (i = 0; i < rounds; i++) { - index = i % 10; - B2B_G( 0, 4, 8, 12, m[sigma[index][ 0]], m[sigma[index][ 1]]); - B2B_G( 1, 5, 9, 13, m[sigma[index][ 2]], m[sigma[index][ 3]]); - B2B_G( 2, 6, 10, 14, m[sigma[index][ 4]], m[sigma[index][ 5]]); - B2B_G( 3, 7, 11, 15, m[sigma[index][ 6]], m[sigma[index][ 7]]); - B2B_G( 0, 5, 10, 15, m[sigma[index][ 8]], m[sigma[index][ 9]]); - B2B_G( 1, 6, 11, 12, m[sigma[index][10]], m[sigma[index][11]]); - B2B_G( 2, 7, 8, 13, m[sigma[index][12]], m[sigma[index][13]]); - B2B_G( 3, 4, 9, 14, m[sigma[index][14]], m[sigma[index][15]]); - } - - for (i = 0; i < 8; ++i) - h[i] ^= v[i] ^ v[i+8]; -} diff --git a/src/hevm/ethjet/blake2.h b/src/hevm/ethjet/blake2.h deleted file mode 100644 index bdd62ddb2..000000000 --- a/src/hevm/ethjet/blake2.h +++ /dev/null @@ -1,17 +0,0 @@ -#ifndef BLAKE2_H -#define BLAKE2_H - -#include - -#ifdef __cplusplus -extern "C" { -#endif - -void -blake2b_compress(uint64_t *h, uint64_t *m, uint64_t *t, char f, uint32_t rounds); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/src/hevm/ethjet/ethjet-ff.cc b/src/hevm/ethjet/ethjet-ff.cc deleted file mode 100644 index c8ab855bb..000000000 --- a/src/hevm/ethjet/ethjet-ff.cc +++ /dev/null @@ -1,278 +0,0 @@ -#include "ethjet.h" - -#include -#include - -#include -#include -#include -#include -#include -#include - -using namespace libff; - -namespace ethjet_ff { - void init() { - libff::inhibit_profiling_info = true; - libff::inhibit_profiling_counters = true; - init_alt_bn128_params(); - } - - // for loading an element of F_q (a coordinate of G_1) - // consumes 32 bytes - alt_bn128_Fq read_Fq_element (uint8_t *in) { - mpz_t x_data; - mpz_init(x_data); - mpz_import(x_data, 32, 1, sizeof(in[0]), 1, 0, in); - - mpz_t q; - mpz_init(q); - alt_bn128_modulus_q.to_mpz(q); - const mp_size_t limbs = alt_bn128_q_limbs; - - if (mpz_cmp(x_data, q) >= 0) - throw 0; - - return Fp_model(bigint(x_data)); - } - - // for loading an element of F_{q^2} (a coordinate of G_2) - // consumes 64 bytes - alt_bn128_Fq2 read_Fq2_element (uint8_t *in) { - // suprising "big-endian" encoding - alt_bn128_Fq x0 = read_Fq_element(in+32); - alt_bn128_Fq x1 = read_Fq_element(in); - - mpz_t q; - mpz_init(q); - alt_bn128_modulus_q.to_mpz(q); - - return Fp2_model(x0, x1); - } - - // for loading an element of F_r (a scalar for G_1) - // consumes 32 bytes - alt_bn128_Fr read_Fr_element (uint8_t *in) { - mpz_t x_data; - mpz_init(x_data); - mpz_import(x_data, 32, 1, sizeof(in[0]), 1, 0, in); - - mpz_t r; - mpz_init(r); - alt_bn128_modulus_r.to_mpz(r); - const mp_size_t limbs = alt_bn128_r_limbs; - - return Fp_model(bigint(x_data)); - } - - // for loading a point in G_1 - // consumes 64 bytes - alt_bn128_G1 read_G1_point (uint8_t *in) { - alt_bn128_Fq ax = read_Fq_element(in); - alt_bn128_Fq ay = read_Fq_element(in+32); - alt_bn128_G1 a; - // create curve point from affine coordinates - // the point at infinity (0,0) is a special case - if (ax.is_zero() && ay.is_zero()) { - a = alt_bn128_G1::G1_zero; - } - else { - a = alt_bn128_G1(ax, ay, alt_bn128_Fq::one()); - } - if (! a.is_well_formed()) { - throw 0; - } - return a; - } - - // for loading a point in G_2 - // consumes 128 bytes - alt_bn128_G2 read_G2_point (uint8_t *in) { - alt_bn128_Fq2 ax = read_Fq2_element(in); - alt_bn128_Fq2 ay = read_Fq2_element(in+64); - alt_bn128_G2 a; - // create curve point from affine coordinates - // the point at infinity (0,0) is a special case - if (ax.is_zero() && ay.is_zero()) { - a = alt_bn128_G2::G2_zero; - return a; - } - a = alt_bn128_G2(ax, ay, alt_bn128_Fq2::one()); - if (! a.is_well_formed()) { - throw 0; - } - // additionally check that the element has the right order - if (-alt_bn128_Fr::one() * a + a != alt_bn128_G2::G2_zero) { - throw 0; - } - return a; - } - - // writes an element of Fq - // produces 32 bytes - void write_Fq_element(uint8_t *out, alt_bn128_Fq x) { - mpz_t x_data; - size_t x_size; - mpz_init(x_data); - - x.as_bigint().to_mpz(x_data); - uint8_t *x_arr = (uint8_t *)mpz_export(NULL, &x_size, 1, 1, 1, 0, x_data); - if (x_size > 32) { - throw 0; - } - // copy the result to the output buffer - // with padding - for (int i = 1; i <= 32; i++) { - if (i <= x_size) - out[32-i] = x_arr[x_size-i]; - else - out[32-i] = 0; - } - return; - } - - // writes an element of F_{q^2} - // produces 64 bytes - void write_Fq2_element(uint8_t *out, alt_bn128_Fq2 x) { - // surprising "big-endian" encoding - write_Fq_element(out+32, x.c0); - write_Fq_element(out, x.c1); - return; - } - - // writes a point of G1 - // produces 64 bytes - void write_G1_point(uint8_t *out, alt_bn128_G1 a) { - // point at infinity is represented as (0,0) - // so treat it as a special case - if (a.is_zero()) { - write_Fq_element(out, alt_bn128_Fq::zero()); - write_Fq_element(out+32, alt_bn128_Fq::zero()); - return; - } - a.to_affine_coordinates(); - write_Fq_element(out, a.X); - write_Fq_element(out+32, a.Y); - return; - } - - // writes a point of G2 - // produces 128 bytes - void write_G2_point(uint8_t *out, alt_bn128_G2 a) { - // point at infinity is represented as (0,0) - // so treat it as a special case - if (a.is_zero()) { - write_Fq2_element(out, alt_bn128_Fq2::zero()); - write_Fq2_element(out+64, alt_bn128_Fq2::zero()); - return; - } - a.to_affine_coordinates(); - write_Fq2_element(out, a.X); - write_Fq2_element(out+64, a.Y); - return; - } - - // writes a bool - // produces 32 bytes - void write_bool(uint8_t *out, bool p) { - out[31] = (int)(p); - for (int i = 2; i <= 32; i++) { - out[32-i] = 0; - } - } -} - -extern "C" { - using namespace ethjet_ff; - - int - ethjet_ecadd (uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size) { - - if (in_size != 128) { - return 0; - } - if (out_size != 64) { - return 0; - } - - init(); - - try { - alt_bn128_G1 a = read_G1_point(in); - alt_bn128_G1 b = read_G1_point(in+64); - alt_bn128_G1 sum = (a + b); - - write_G1_point(out, sum); - } - catch (int e) { - return 0; - } - - return 1; - } - - int - ethjet_ecmul (uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size) { - - if (in_size != 96) { - return 0; - } - if (out_size != 64) { - return 0; - } - - init(); - - try { - alt_bn128_G1 a = read_G1_point(in); - alt_bn128_Fr n = read_Fr_element(in+64); - alt_bn128_G1 na = n * a; - - write_G1_point(out, na); - } - catch (int e) { - return 0; - } - - return 1; - } - - int - ethjet_ecpairing (uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size) { - - if (in_size % 192 != 0) - return 0; - - if (out_size != 32) - return 0; - - init(); - int pairs = in_size / 192; - - try { - alt_bn128_Fq12 x = libff::alt_bn128_Fq12::one(); - for (int i = 0; i < pairs; i++) { - alt_bn128_G1 a = read_G1_point(in + i*192); - alt_bn128_G2 b = read_G2_point(in + i*192 + 64); - if (a.is_zero() || b.is_zero()) - continue; - x = x * alt_bn128_miller_loop(alt_bn128_precompute_G1(a), alt_bn128_precompute_G2(b)); - } - bool result; - if (pairs == 0) - result = true; - else - result = (alt_bn128_final_exponentiation(x) == alt_bn128_GT::one()); - write_bool(out, result); - } - catch (int e) { - return 0; - } - - return 1; - } -} diff --git a/src/hevm/ethjet/ethjet-ff.h b/src/hevm/ethjet/ethjet-ff.h deleted file mode 100644 index 386d6d5c7..000000000 --- a/src/hevm/ethjet/ethjet-ff.h +++ /dev/null @@ -1,18 +0,0 @@ -#ifndef ETHJET_FF_H -#define ETHJET_FF_H - -#include - -int -ethjet_ecadd (uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size); - -int -ethjet_ecmul (uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size); - -int -ethjet_ecpairing (uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size); - -#endif diff --git a/src/hevm/ethjet/ethjet.c b/src/hevm/ethjet/ethjet.c deleted file mode 100644 index e118692c7..000000000 --- a/src/hevm/ethjet/ethjet.c +++ /dev/null @@ -1,144 +0,0 @@ -#include "ethjet.h" -#include "ethjet-ff.h" -#include "tinykeccak.h" -#include "blake2.h" - -#include - -#include -#include -#include - -struct ethjet_context * -ethjet_init () -{ - struct ethjet_context *ctx; - ctx = malloc (sizeof *ctx); - if (!ctx) return NULL; - - ctx->ec = secp256k1_context_create (SECP256K1_CONTEXT_VERIFY); - - return ctx; -} - -void -ethjet_free (struct ethjet_context *ctx) -{ - secp256k1_context_destroy (ctx->ec); - free (ctx); -} - -/* - * The example contract at 0xdeadbeef just reverses its input. - */ -int -ethjet_example (struct ethjet_context *ctx, - uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size) -{ - if (out_size != in_size) - return 0; - - for (int i = 0; i < in_size; i++) - out[i] = in[in_size - i - 1]; - - return 1; -} - -int -ethjet_ecrecover (secp256k1_context *ctx, - uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size) -{ - /* Input: H V R S, all 32 bytes. */ - - secp256k1_pubkey pubkey; - secp256k1_ecdsa_recoverable_signature rsig; - - uint8_t *input64; - uint8_t pubkey_hex[65]; - size_t hexlen = 65; - - int recid; - - if (in_size != 128) - return 0; - - if (out_size != 32) - return 0; - - input64 = in + 64; - recid = in[63] - 27; - - /* higher bytes of V should be zero */ - static const char z31 [31]; - if (memcmp (z31, in + 32, 31)) - return 0; - - if (recid < 0 || recid > 3) - return 0; - - if (!secp256k1_ecdsa_recoverable_signature_parse_compact - (ctx, &rsig, input64, recid)) - return 0; - - if (!secp256k1_ecdsa_recover (ctx, &pubkey, &rsig, in)) - return 0; - - if (!secp256k1_ec_pubkey_serialize - (ctx, pubkey_hex, &hexlen, &pubkey, SECP256K1_EC_UNCOMPRESSED)) - return 0; - - if (sha3_256 (out, 32, pubkey_hex + 1, 64)) - return 0; - - memset (out, 0, 12); - - return 1; -} - -int ethjet_blake2(uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size) { - uint32_t rounds = in[0] << 24 | in[1] << 16 | in[2] << 8 | in[3]; - unsigned char f = in[212]; - uint64_t *h = (uint64_t *)&in[4]; - uint64_t *m = (uint64_t *)&in[68]; - uint64_t *t = (uint64_t *)&in[196]; - - blake2b_compress(h, m, t, f, rounds); - - memcpy(out, h, out_size); - - return 1; -} - -int -ethjet (struct ethjet_context *ctx, - enum ethjet_operation op, - uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size) -{ - switch (op) { - case ETHJET_ECRECOVER: - return ethjet_ecrecover (ctx->ec, in, in_size, out, out_size); - break; - - case ETHJET_EXAMPLE: - return ethjet_example (ctx, in, in_size, out, out_size); - - case ETHJET_ECADD: - return ethjet_ecadd (in, in_size, out, out_size); - - case ETHJET_ECMUL: - return ethjet_ecmul (in, in_size, out, out_size); - - case ETHJET_ECPAIRING: - return ethjet_ecpairing (in, in_size, out, out_size); - - case ETHJET_BLAKE2: - return ethjet_blake2 (in, in_size, out, out_size); - - default: - return 0; - } -} diff --git a/src/hevm/ethjet/ethjet.h b/src/hevm/ethjet/ethjet.h deleted file mode 100644 index 8aba292b4..000000000 --- a/src/hevm/ethjet/ethjet.h +++ /dev/null @@ -1,34 +0,0 @@ -#ifndef LIBETHJET_H -#define LIBETHJET_H - -#include - -#include - -struct ethjet_context -{ - secp256k1_context *ec; -}; - -enum ethjet_operation - { - ETHJET_ECRECOVER = 1, - ETHJET_ECADD = 6, - ETHJET_ECMUL = 7, - ETHJET_ECPAIRING = 8, - ETHJET_BLAKE2 = 9, - ETHJET_EXAMPLE = 0xdeadbeef, - }; - -struct ethjet_context * -ethjet_init (); - -void -ethjet_free (struct ethjet_context *ctx); - -int ethjet (struct ethjet_context *ctx, - enum ethjet_operation op, - uint8_t *in, size_t in_size, - uint8_t *out, size_t out_size); - -#endif diff --git a/src/hevm/ethjet/tinykeccak.c b/src/hevm/ethjet/tinykeccak.c deleted file mode 100644 index f45106c34..000000000 --- a/src/hevm/ethjet/tinykeccak.c +++ /dev/null @@ -1,152 +0,0 @@ -/** libkeccak-tiny -* -* A single-file implementation of SHA-3 and SHAKE. -* -* Implementor: David Leon Gil -* License: CC0, attribution kindly requested. Blame taken too, -* but not liability. -*/ - -#include "tinykeccak.h" - -#include -#include -#include -#include - -/******** The Keccak-f[1600] permutation ********/ - -/*** Constants. ***/ -static const uint8_t rho[24] = \ - { 1, 3, 6, 10, 15, 21, - 28, 36, 45, 55, 2, 14, - 27, 41, 56, 8, 25, 43, - 62, 18, 39, 61, 20, 44}; -static const uint8_t pi[24] = \ - {10, 7, 11, 17, 18, 3, - 5, 16, 8, 21, 24, 4, - 15, 23, 19, 13, 12, 2, - 20, 14, 22, 9, 6, 1}; -static const uint64_t RC[24] = \ - {1ULL, 0x8082ULL, 0x800000000000808aULL, 0x8000000080008000ULL, - 0x808bULL, 0x80000001ULL, 0x8000000080008081ULL, 0x8000000000008009ULL, - 0x8aULL, 0x88ULL, 0x80008009ULL, 0x8000000aULL, - 0x8000808bULL, 0x800000000000008bULL, 0x8000000000008089ULL, 0x8000000000008003ULL, - 0x8000000000008002ULL, 0x8000000000000080ULL, 0x800aULL, 0x800000008000000aULL, - 0x8000000080008081ULL, 0x8000000000008080ULL, 0x80000001ULL, 0x8000000080008008ULL}; - -/*** Helper macros to unroll the permutation. ***/ -#define rol(x, s) (((x) << s) | ((x) >> (64 - s))) -#define REPEAT6(e) e e e e e e -#define REPEAT24(e) REPEAT6(e e e e) -#define REPEAT5(e) e e e e e -#define FOR5(v, s, e) \ - v = 0; \ - REPEAT5(e; v += s;) - -/*** Keccak-f[1600] ***/ -static inline void keccakf(void* state) { - uint64_t* a = (uint64_t*)state; - uint64_t b[5] = {0}; - uint64_t t = 0; - uint8_t x, y; - - for (int i = 0; i < 24; i++) { - // Theta - FOR5(x, 1, - b[x] = 0; - FOR5(y, 5, - b[x] ^= a[x + y]; )) - FOR5(x, 1, - FOR5(y, 5, - a[y + x] ^= b[(x + 4) % 5] ^ rol(b[(x + 1) % 5], 1); )) - // Rho and pi - t = a[1]; - x = 0; - REPEAT24(b[0] = a[pi[x]]; - a[pi[x]] = rol(t, rho[x]); - t = b[0]; - x++; ) - // Chi - FOR5(y, - 5, - FOR5(x, 1, - b[x] = a[y + x];) - FOR5(x, 1, - a[y + x] = b[x] ^ ((~b[(x + 1) % 5]) & b[(x + 2) % 5]); )) - // Iota - a[0] ^= RC[i]; - } -} - -/******** The FIPS202-defined functions. ********/ - -/*** Some helper macros. ***/ - -#define _(S) do { S } while (0) -#define FOR(i, ST, L, S) \ - _(for (size_t i = 0; i < L; i += ST) { S; }) -#define mkapply_ds(NAME, S) \ - static inline void NAME(uint8_t* dst, \ - const uint8_t* src, \ - size_t len) { \ - FOR(i, 1, len, S); \ - } -#define mkapply_sd(NAME, S) \ - static inline void NAME(const uint8_t* src, \ - uint8_t* dst, \ - size_t len) { \ - FOR(i, 1, len, S); \ - } - -mkapply_ds(xorin, dst[i] ^= src[i]) // xorin -mkapply_sd(setout, dst[i] = src[i]) // setout - -#define P keccakf -#define Plen 200 - -// Fold P*F over the full blocks of an input. -#define foldP(I, L, F) \ - while (L >= rate) { \ - F(a, I, rate); \ - P(a); \ - I += rate; \ - L -= rate; \ - } - -/** The sponge-based hash construction. **/ -static inline int hash(uint8_t* out, size_t outlen, - const uint8_t* in, size_t inlen, - size_t rate, uint8_t delim) { - if ((out == NULL) || ((in == NULL) && inlen != 0) || (rate >= Plen)) { - return -1; - } - uint8_t a[Plen] = {0}; - // Absorb input. - foldP(in, inlen, xorin); - // Xor in the DS and pad frame. - a[inlen] ^= delim; - a[rate - 1] ^= 0x80; - // Xor in the last block. - xorin(a, in, inlen); - // Apply P - P(a); - // Squeeze output. - foldP(out, outlen, setout); - setout(a, out, outlen); - memset(a, 0, 200); - return 0; -} - -#define defsha3(bits) \ - int sha3_##bits(uint8_t* out, size_t outlen, \ - const uint8_t* in, size_t inlen) { \ - if (outlen > (bits/8)) { \ - return -1; \ - } \ - return hash(out, outlen, in, inlen, 200 - (bits / 4), 0x01); \ - } - -/*** FIPS202 SHA3 FOFs ***/ -defsha3(256) -defsha3(512) diff --git a/src/hevm/ethjet/tinykeccak.h b/src/hevm/ethjet/tinykeccak.h deleted file mode 100644 index 386e7f0d6..000000000 --- a/src/hevm/ethjet/tinykeccak.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef KECCAK_H -#define KECCAK_H - -#include -#include - -int sha3_256 (uint8_t *out, size_t out_size, - const uint8_t *in, size_t in_size); - -#endif diff --git a/src/hevm/hevm-cli/hevm-cli.hs b/src/hevm/hevm-cli/hevm-cli.hs deleted file mode 100644 index c8f303522..000000000 --- a/src/hevm/hevm-cli/hevm-cli.hs +++ /dev/null @@ -1,984 +0,0 @@ --- Main file of the hevm CLI program - -{-# Language CPP #-} -{-# Language DataKinds #-} -{-# Language StandaloneDeriving #-} -{-# Language DeriveAnyClass #-} -{-# Language FlexibleInstances #-} -{-# Language DeriveGeneric #-} -{-# Language GADTs #-} -{-# Language LambdaCase #-} -{-# Language OverloadedStrings #-} -{-# Language TypeOperators #-} -{-# Language RecordWildCards #-} - -module Main where - -import EVM (StorageModel(..)) -import qualified EVM -import EVM.Concrete (createAddress, wordValue) -import EVM.Symbolic (litWord, forceLitBytes, litAddr, len, forceLit) -import qualified EVM.FeeSchedule as FeeSchedule -import qualified EVM.Fetch -import qualified EVM.Flatten -import qualified EVM.Stepper -import qualified EVM.TTY -import qualified EVM.Emacs -import EVM.Dev (interpretWithTrace) - -#if MIN_VERSION_aeson(1, 0, 0) -import qualified EVM.VMTest as VMTest -#endif - -import EVM.SymExec -import EVM.Debug -import EVM.ABI -import EVM.Solidity -import EVM.Types hiding (word) -import EVM.UnitTest (UnitTestOptions, coverageReport, coverageForUnitTestContract) -import EVM.UnitTest (runUnitTestContract) -import EVM.UnitTest (getParametersFromEnvironmentVariables, testNumber) -import EVM.Dapp (findUnitTests, dappInfo, DappInfo, emptyDapp) -import EVM.Format (showTraceTree, showTree', renderTree, showBranchInfoWithAbi, showLeafInfo) -import EVM.RLP (rlpdecode) -import qualified EVM.Patricia as Patricia -import Data.Map (Map) - -import qualified EVM.Facts as Facts -import qualified EVM.Facts.Git as Git -import qualified EVM.UnitTest - -import GHC.IO.Encoding -import GHC.Stack -import Control.Concurrent.Async (async, waitCatch) -import Control.Lens hiding (pre, passing) -import Control.Monad (void, when, forM_, unless) -import Control.Monad.State.Strict (execStateT, liftIO) -import Data.ByteString (ByteString) -import Data.List (intercalate, isSuffixOf) -import Data.Tree -import Data.Text (unpack, pack) -import Data.Text.Encoding (encodeUtf8) -import Data.Text.IO (hPutStr) -import Data.Maybe (fromMaybe, fromJust) -import Data.Version (showVersion) -import Data.DoubleWord (Word256) -import Data.SBV hiding (Word, solver, verbose, name) -import Data.SBV.Control hiding (Version, timeout, create) -import System.IO (hFlush, stdout, stderr) -import System.Directory (withCurrentDirectory, listDirectory) -import System.Exit (exitFailure, exitWith, ExitCode(..)) -import System.Environment (setEnv) -import System.Process (callProcess) -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Types as JSON -import Data.Aeson (FromJSON (..), (.:)) -import Data.Aeson.Lens hiding (values) -import qualified Data.Vector as V -import qualified Data.ByteString.Lazy as Lazy - -import qualified Data.SBV as SBV -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.ByteString.Lazy as LazyByteString -import qualified Data.Map as Map -import qualified Data.Text as Text -import qualified System.Timeout as Timeout - -import qualified Paths_hevm as Paths - -import Options.Generic as Options - --- This record defines the program's command-line options --- automatically via the `optparse-generic` package. -data Command w - = Symbolic -- Symbolically explore an abstract program, or specialized with specified env & calldata - -- vm opts - { code :: w ::: Maybe ByteString "Program bytecode" - , calldata :: w ::: Maybe ByteString "Tx: calldata" - , address :: w ::: Maybe Addr "Tx: address" - , caller :: w ::: Maybe Addr "Tx: caller" - , origin :: w ::: Maybe Addr "Tx: origin" - , coinbase :: w ::: Maybe Addr "Block: coinbase" - , value :: w ::: Maybe W256 "Tx: Eth amount" - , nonce :: w ::: Maybe W256 "Nonce of origin" - , gas :: w ::: Maybe W256 "Tx: gas amount" - , number :: w ::: Maybe W256 "Block: number" - , timestamp :: w ::: Maybe W256 "Block: timestamp" - , basefee :: w ::: Maybe W256 "Block: base fee" - , priorityFee :: w ::: Maybe W256 "Tx: priority fee" - , gaslimit :: w ::: Maybe W256 "Tx: gas limit" - , gasprice :: w ::: Maybe W256 "Tx: gas price" - , create :: w ::: Bool "Tx: creation" - , maxcodesize :: w ::: Maybe W256 "Block: max code size" - , difficulty :: w ::: Maybe W256 "Block: difficulty" - , chainid :: w ::: Maybe W256 "Env: chainId" - -- remote state opts - , rpc :: w ::: Maybe URL "Fetch state from a remote node" - , block :: w ::: Maybe W256 "Block state is be fetched from" - , state :: w ::: Maybe String "Path to state repository" - , cache :: w ::: Maybe String "Path to rpc cache repository" - - -- symbolic execution opts - , jsonFile :: w ::: Maybe String "Filename or path to dapp build output (default: out/*.solc.json)" - , dappRoot :: w ::: Maybe String "Path to dapp project root directory (default: . )" - , storageModel :: w ::: Maybe StorageModel "Select storage model: ConcreteS, SymbolicS (default) or InitialS" - , sig :: w ::: Maybe Text "Signature of types to decode / encode" - , arg :: w ::: [String] "Values to encode" - , debug :: w ::: Bool "Run interactively" - , getModels :: w ::: Bool "Print example testcase for each execution path" - , showTree :: w ::: Bool "Print branches explored in tree view" - , smttimeout :: w ::: Maybe Integer "Timeout given to SMT solver in milliseconds (default: 60000)" - , maxIterations :: w ::: Maybe Integer "Number of times we may revisit a particular branching point" - , solver :: w ::: Maybe Text "Used SMT solver: z3 (default) or cvc4" - , smtdebug :: w ::: Bool "Print smt queries sent to the solver" - , assertions :: w ::: Maybe [Word256] "Comma seperated list of solc panic codes to check for (default: everything except arithmetic overflow)" - , askSmtIterations :: w ::: Maybe Integer "Number of times we may revisit a particular branching point before we consult the smt solver to check reachability (default: 5)" - } - | Equivalence -- prove equivalence between two programs - { codeA :: w ::: ByteString "Bytecode of the first program" - , codeB :: w ::: ByteString "Bytecode of the second program" - , sig :: w ::: Maybe Text "Signature of types to decode / encode" - , smttimeout :: w ::: Maybe Integer "Timeout given to SMT solver in milliseconds (default: 60000)" - , maxIterations :: w ::: Maybe Integer "Number of times we may revisit a particular branching point" - , solver :: w ::: Maybe Text "Used SMT solver: z3 (default) or cvc4" - , smtoutput :: w ::: Bool "Print verbose smt output" - , smtdebug :: w ::: Bool "Print smt queries sent to the solver" - , askSmtIterations :: w ::: Maybe Integer "Number of times we may revisit a particular branching point before we consult the smt solver to check reachability (default: 5)" - } - | Exec -- Execute a given program with specified env & calldata - { code :: w ::: Maybe ByteString "Program bytecode" - , calldata :: w ::: Maybe ByteString "Tx: calldata" - , address :: w ::: Maybe Addr "Tx: address" - , caller :: w ::: Maybe Addr "Tx: caller" - , origin :: w ::: Maybe Addr "Tx: origin" - , coinbase :: w ::: Maybe Addr "Block: coinbase" - , value :: w ::: Maybe W256 "Tx: Eth amount" - , nonce :: w ::: Maybe W256 "Nonce of origin" - , gas :: w ::: Maybe W256 "Tx: gas amount" - , number :: w ::: Maybe W256 "Block: number" - , timestamp :: w ::: Maybe W256 "Block: timestamp" - , basefee :: w ::: Maybe W256 "Block: base fee" - , priorityFee :: w ::: Maybe W256 "Tx: priority fee" - , gaslimit :: w ::: Maybe W256 "Tx: gas limit" - , gasprice :: w ::: Maybe W256 "Tx: gas price" - , create :: w ::: Bool "Tx: creation" - , maxcodesize :: w ::: Maybe W256 "Block: max code size" - , difficulty :: w ::: Maybe W256 "Block: difficulty" - , chainid :: w ::: Maybe W256 "Env: chainId" - , debug :: w ::: Bool "Run interactively" - , jsontrace :: w ::: Bool "Print json trace output at every step" - , trace :: w ::: Bool "Dump trace" - , state :: w ::: Maybe String "Path to state repository" - , cache :: w ::: Maybe String "Path to rpc cache repository" - , rpc :: w ::: Maybe URL "Fetch state from a remote node" - , block :: w ::: Maybe W256 "Block state is be fetched from" - , jsonFile :: w ::: Maybe String "Filename or path to dapp build output (default: out/*.solc.json)" - , dappRoot :: w ::: Maybe String "Path to dapp project root directory (default: . )" - } - | DappTest -- Run DSTest unit tests - { jsonFile :: w ::: Maybe String "Filename or path to dapp build output (default: out/*.solc.json)" - , dappRoot :: w ::: Maybe String "Path to dapp project root directory (default: . )" - , debug :: w ::: Bool "Run interactively" - , jsontrace :: w ::: Bool "Print json trace output at every step" - , fuzzRuns :: w ::: Maybe Int "Number of times to run fuzz tests" - , depth :: w ::: Maybe Int "Number of transactions to explore" - , replay :: w ::: Maybe (Text, ByteString) "Custom fuzz case to run/debug" - , rpc :: w ::: Maybe URL "Fetch state from a remote node" - , verbose :: w ::: Maybe Int "Append call trace: {1} failures {2} all" - , coverage :: w ::: Bool "Coverage analysis" - , state :: w ::: Maybe String "Path to state repository" - , cache :: w ::: Maybe String "Path to rpc cache repository" - , match :: w ::: Maybe String "Test case filter - only run methods matching regex" - , covMatch :: w ::: Maybe String "Coverage filter - only print coverage for files matching regex" - , solver :: w ::: Maybe Text "Used SMT solver: z3 (default) or cvc4" - , smtdebug :: w ::: Bool "Print smt queries sent to the solver" - , ffi :: w ::: Bool "Allow the usage of the hevm.ffi() cheatcode (WARNING: this allows test authors to execute arbitrary code on your machine)" - , smttimeout :: w ::: Maybe Integer "Timeout given to SMT solver in milliseconds (default: 60000)" - , maxIterations :: w ::: Maybe Integer "Number of times we may revisit a particular branching point" - , askSmtIterations :: w ::: Maybe Integer "Number of times we may revisit a particular branching point before we consult the smt solver to check reachability (default: 5)" - } - | BcTest -- Run an Ethereum Blockchain/GeneralState test - { file :: w ::: String "Path to .json test file" - , test :: w ::: [String] "Test case filter - only run specified test method(s)" - , debug :: w ::: Bool "Run interactively" - , jsontrace :: w ::: Bool "Print json trace output at every step" - , diff :: w ::: Bool "Print expected vs. actual state on failure" - , timeout :: w ::: Maybe Int "Execution timeout (default: 10 sec.)" - } - | Compliance -- Run Ethereum Blockchain compliance report - { tests :: w ::: String "Path to Ethereum Tests directory" - , group :: w ::: Maybe String "Report group to run: VM or Blockchain (default: Blockchain)" - , match :: w ::: Maybe String "Test case filter - only run methods matching regex" - , skip :: w ::: Maybe String "Test case filter - skip tests containing string" - , html :: w ::: Bool "Output html report" - , timeout :: w ::: Maybe Int "Execution timeout (default: 10 sec.)" - } - | Flatten -- Concat all dependencies for a given source file - { sourceFile :: w ::: String "Path to solidity source file e.g. src/contract.sol" - , jsonFile :: w ::: Maybe String "Filename or path to dapp build output (default: out/*.solc.json)" - , dappRoot :: w ::: Maybe String "Path to dapp project root directory (default: . )" - } - | Emacs - | Version - | Rlp -- RLP decode a string and print the result - { decode :: w ::: ByteString "RLP encoded hexstring" - } - | Abiencode - { abi :: w ::: Maybe String "Signature of types to decode / encode" - , arg :: w ::: [String] "Values to encode" - } - | MerkleTest -- Insert a set of key values and check against the given root - { file :: w ::: String "Path to .json test file" - } - | StripMetadata -- Remove metadata from contract bytecode - { code :: w ::: Maybe ByteString "Program bytecode" - } - - deriving (Options.Generic) - -type URL = Text - - --- For some reason haskell can't derive a --- parseField instance for (Text, ByteString) -instance Options.ParseField (Text, ByteString) - -deriving instance Options.ParseField Word256 -deriving instance Options.ParseField [Word256] - -instance Options.ParseRecord (Command Options.Wrapped) where - parseRecord = - Options.parseRecordWithModifiers Options.lispCaseModifiers - -optsMode :: Command Options.Unwrapped -> Mode -optsMode x = if debug x then Debug else if jsontrace x then JsonTrace else Run - -applyCache :: (Maybe String, Maybe String) -> IO (EVM.VM -> EVM.VM) -applyCache (state, cache) = - let applyState = flip Facts.apply - applyCache' = flip Facts.applyCache - in case (state, cache) of - (Nothing, Nothing) -> do - pure id - (Nothing, Just cachePath) -> do - facts <- Git.loadFacts (Git.RepoAt cachePath) - pure $ applyCache' facts - (Just statePath, Nothing) -> do - facts <- Git.loadFacts (Git.RepoAt statePath) - pure $ applyState facts - (Just statePath, Just cachePath) -> do - cacheFacts <- Git.loadFacts (Git.RepoAt cachePath) - stateFacts <- Git.loadFacts (Git.RepoAt statePath) - pure $ (applyState stateFacts) . (applyCache' cacheFacts) - -unitTestOptions :: Command Options.Unwrapped -> String -> Query UnitTestOptions -unitTestOptions cmd testFile = do - let root = fromMaybe "." (dappRoot cmd) - srcInfo <- liftIO $ readSolc testFile >>= \case - Nothing -> error "Could not read .sol.json file" - Just (contractMap, sourceCache) -> - pure $ dappInfo root contractMap sourceCache - - vmModifier <- liftIO $ applyCache (state cmd, cache cmd) - - params <- liftIO $ getParametersFromEnvironmentVariables (rpc cmd) - state <- queryState - - let - testn = testNumber params - block' = if 0 == testn - then EVM.Fetch.Latest - else EVM.Fetch.BlockNumber testn - - pure EVM.UnitTest.UnitTestOptions - { EVM.UnitTest.oracle = - case rpc cmd of - Just url -> EVM.Fetch.oracle (Just state) (Just (block', url)) True - Nothing -> EVM.Fetch.oracle (Just state) Nothing True - , EVM.UnitTest.maxIter = maxIterations cmd - , EVM.UnitTest.askSmtIters = askSmtIterations cmd - , EVM.UnitTest.smtTimeout = smttimeout cmd - , EVM.UnitTest.solver = solver cmd - , EVM.UnitTest.covMatch = pack <$> covMatch cmd - , EVM.UnitTest.smtState = Just state - , EVM.UnitTest.verbose = verbose cmd - , EVM.UnitTest.match = pack $ fromMaybe ".*" (match cmd) - , EVM.UnitTest.maxDepth = depth cmd - , EVM.UnitTest.fuzzRuns = fromMaybe 100 (fuzzRuns cmd) - , EVM.UnitTest.replay = do - arg' <- replay cmd - return (fst arg', LazyByteString.fromStrict (hexByteString "--replay" $ strip0x $ snd arg')) - , EVM.UnitTest.vmModifier = vmModifier - , EVM.UnitTest.testParams = params - , EVM.UnitTest.dapp = srcInfo - , EVM.UnitTest.ffiAllowed = ffi cmd - } - -main :: IO () -main = do - cmd <- Options.unwrapRecord "hevm -- Ethereum evaluator" - let - root = fromMaybe "." (dappRoot cmd) - case cmd of - Version {} -> putStrLn (showVersion Paths.version) - Symbolic {} -> withCurrentDirectory root $ assert cmd - Equivalence {} -> equivalence cmd - Exec {} -> - launchExec cmd - Abiencode {} -> - print . ByteStringS $ abiencode (abi cmd) (arg cmd) - BcTest {} -> - launchTest cmd - DappTest {} -> - withCurrentDirectory root $ do - testFile <- findJsonFile (jsonFile cmd) - runSMTWithTimeOut (solver cmd) (smttimeout cmd) (smtdebug cmd) $ query $ do - testOpts <- unitTestOptions cmd testFile - case (coverage cmd, optsMode cmd) of - (False, Run) -> dappTest testOpts testFile (cache cmd) - (False, Debug) -> liftIO $ EVM.TTY.main testOpts root testFile - (False, JsonTrace) -> error "json traces not implemented for dappTest" - (True, _) -> liftIO $ dappCoverage testOpts (optsMode cmd) testFile - Compliance {} -> - case (group cmd) of - Just "Blockchain" -> launchScript "/run-blockchain-tests" cmd - Just "VM" -> launchScript "/run-consensus-tests" cmd - _ -> launchScript "/run-blockchain-tests" cmd - Flatten {} -> - withCurrentDirectory root $ do - theJson <- findJsonFile (jsonFile cmd) - readSolc theJson >>= - \case - Just (contractMap, cache) -> do - let dapp = dappInfo "." contractMap cache - EVM.Flatten.flatten dapp (pack (sourceFile cmd)) - Nothing -> - error ("Failed to read Solidity JSON for `" ++ theJson ++ "'") - Emacs -> - EVM.Emacs.main - Rlp {} -> - case rlpdecode $ hexByteString "--decode" $ strip0x $ decode cmd of - Nothing -> error "Malformed RLP string" - Just c -> print c - MerkleTest {} -> merkleTest cmd - StripMetadata {} -> print . - ByteStringS . stripBytecodeMetadata . hexByteString "bytecode" . strip0x $ fromJust $ code cmd - -launchScript :: String -> Command Options.Unwrapped -> IO () -launchScript script cmd = - withCurrentDirectory (tests cmd) $ do - dataDir <- Paths.getDataDir - callProcess "bash" - [ dataDir ++ script - , "." - , show (html cmd) - , fromMaybe "" (match cmd) - , fromMaybe "" (skip cmd) - , show $ fromMaybe 10 (timeout cmd) - ] - -findJsonFile :: Maybe String -> IO String -findJsonFile (Just s) = pure s -findJsonFile Nothing = do - outFiles <- listDirectory "out" - case filter (isSuffixOf ".sol.json") outFiles of - [x] -> pure ("out/" ++ x) - [] -> - error $ concat - [ "No `*.sol.json' file found in `./out'.\n" - , "Maybe you need to run `dapp build'.\n" - , "You can specify a file with `--json-file'." - ] - xs -> - error $ concat - [ "Multiple `*.sol.json' files found in `./out'.\n" - , "Specify one using `--json-file'.\n" - , "Files found: " - , intercalate ", " xs - ] - -dappTest :: UnitTestOptions -> String -> Maybe String -> Query () -dappTest opts solcFile cache = do - out <- liftIO $ readSolc solcFile - case out of - Just (contractMap, _) -> do - let unitTests = findUnitTests (EVM.UnitTest.match opts) $ Map.elems contractMap - results <- concatMapM (runUnitTestContract opts contractMap) unitTests - let (passing, vms) = unzip results - case cache of - Nothing -> - pure () - Just path -> - -- merge all of the post-vm caches and save into the state - let - cache' = mconcat [view EVM.cache vm | vm <- vms] - in - liftIO $ Git.saveFacts (Git.RepoAt path) (Facts.cacheFacts cache') - - liftIO $ unless (and passing) exitFailure - Nothing -> - error ("Failed to read Solidity JSON for `" ++ solcFile ++ "'") - -equivalence :: Command Options.Unwrapped -> IO () -equivalence cmd = - do let bytecodeA = hexByteString "--code" . strip0x $ codeA cmd - bytecodeB = hexByteString "--code" . strip0x $ codeB cmd - maybeSignature <- case sig cmd of - Nothing -> return Nothing - Just sig' -> do method' <- functionAbi sig' - return $ Just (view methodSignature method', snd <$> view methodInputs method') - - void . runSMTWithTimeOut (solver cmd) (smttimeout cmd) (smtdebug cmd) . query $ - equivalenceCheck bytecodeA bytecodeB (maxIterations cmd) (askSmtIterations cmd) maybeSignature >>= \case - Cex vm -> do - io $ putStrLn "Not equal!" - io $ putStrLn "Counterexample:" - showCounterexample vm maybeSignature - io exitFailure - Qed (postAs, postBs) -> io $ do - putStrLn $ "Explored: " <> show (length postAs) - <> " execution paths of A and: " - <> show (length postBs) <> " paths of B." - putStrLn "No discrepancies found." - Timeout () -> io $ do - hPutStr stderr "Solver timeout!" - exitFailure - --- cvc4 sets timeout via a commandline option instead of smtlib `(set-option)` -runSMTWithTimeOut :: Maybe Text -> Maybe Integer -> Bool -> Symbolic a -> IO a -runSMTWithTimeOut solver maybeTimeout smtdebug symb - | solver == Just "cvc4" = runwithcvc4 - | solver == Just "z3" = runwithz3 - | solver == Nothing = runwithz3 - | otherwise = error "Unknown solver. Currently supported solvers; z3, cvc4" - where timeout = fromMaybe 60000 maybeTimeout - runwithz3 = runSMTWith z3{SBV.verbose=smtdebug} $ (setTimeOut timeout) >> symb - runwithcvc4 = do - setEnv "SBV_CVC4_OPTIONS" ("--lang=smt --incremental --interactive --no-interactive-prompt --model-witness-value --tlimit-per=" <> show timeout) - a <- runSMTWith cvc4{SBV.verbose=smtdebug} symb - setEnv "SBV_CVC4_OPTIONS" "" - return a - - - -checkForVMErrors :: [EVM.VM] -> [String] -checkForVMErrors [] = [] -checkForVMErrors (vm:vms) = - case view EVM.result vm of - Just (EVM.VMFailure EVM.UnexpectedSymbolicArg) -> - ("Unexpected symbolic argument at opcode: " - <> maybe "??" show (EVM.vmOp vm) - <> ". Not supported (yet!)" - ) : checkForVMErrors vms - _ -> - checkForVMErrors vms - -getSrcInfo :: Command Options.Unwrapped -> IO DappInfo -getSrcInfo cmd = - let root = fromMaybe "." (dappRoot cmd) - in case (jsonFile cmd) of - Nothing -> - pure emptyDapp - Just json -> readSolc json >>= \case - Nothing -> - pure emptyDapp - Just (contractMap, sourceCache) -> - pure $ dappInfo root contractMap sourceCache - --- Although it is tempting to fully abstract calldata and give any hints about --- the nature of the signature doing so results in significant time spent in --- consulting z3 about rather trivial matters. But with cvc4 it is quite --- pleasant! - --- If function signatures are known, they should always be given for best results. -assert :: Command Options.Unwrapped -> IO () -assert cmd = do - srcInfo <- getSrcInfo cmd - let block' = maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (block cmd) - rpcinfo = (,) block' <$> rpc cmd - treeShowing :: Tree BranchInfo -> Query () - treeShowing tree = - when (showTree cmd) $ do - consistentTree tree >>= \case - Nothing -> io $ putStrLn "No consistent paths" -- unlikely - Just tree' -> let - showBranch = showBranchInfoWithAbi srcInfo - renderTree' = renderTree showBranch (showLeafInfo srcInfo) - in io $ setLocaleEncoding utf8 >> putStrLn (showTree' (renderTree' tree')) - - maybesig <- case sig cmd of - Nothing -> - return Nothing - Just sig' -> do - method' <- functionAbi sig' - let typ = snd <$> view methodInputs method' - name = view methodSignature method' - return $ Just (name,typ) - if debug cmd then - runSMTWithTimeOut (solver cmd) (smttimeout cmd) (smtdebug cmd) $ query $ do - preState <- symvmFromCommand cmd - smtState <- queryState - io $ void $ EVM.TTY.runFromVM - (maxIterations cmd) - srcInfo - (EVM.Fetch.oracle (Just smtState) rpcinfo True) - preState - - else - runSMTWithTimeOut (solver cmd) (smttimeout cmd) (smtdebug cmd) $ query $ do - preState <- symvmFromCommand cmd - let errCodes = fromMaybe defaultPanicCodes (assertions cmd) - verify preState (maxIterations cmd) (askSmtIterations cmd) rpcinfo (Just $ checkAssertions errCodes) >>= \case - Cex tree -> do - io $ putStrLn "Assertion violation found." - showCounterexample preState maybesig - treeShowing tree - io $ exitWith (ExitFailure 1) - Timeout tree -> do - treeShowing tree - io $ exitWith (ExitFailure 1) - Qed tree -> do - io $ putStrLn $ "Explored: " <> show (length tree) - <> " branches without assertion violations" - treeShowing tree - let vmErrs = checkForVMErrors $ leaves tree - unless (null vmErrs) $ io $ do - putStrLn $ - "However, " - <> show (length vmErrs) - <> " branch(es) errored while exploring:" - print vmErrs - -- When `--get-models` is passed, we print example vm info for each path - when (getModels cmd) $ - forM_ (zip [(1:: Integer)..] (leaves tree)) $ \(i, postVM) -> do - resetAssertions - constrain (sAnd (fst <$> view EVM.constraints postVM)) - io $ putStrLn $ - "-- Branch (" <> show i <> "/" <> show (length tree) <> ") --" - checkSat >>= \case - DSat _ -> error "assert: unexpected SMT result" - Unk -> io $ do putStrLn "Timed out" - print $ view EVM.result postVM - Unsat -> io $ do putStrLn "Inconsistent path conditions: dead path" - print $ view EVM.result postVM - Sat -> do - showCounterexample preState maybesig - io $ putStrLn "-- Pathconditions --" - io $ print $ snd <$> view EVM.constraints postVM - case view EVM.result postVM of - Nothing -> - error "internal error; no EVM result" - Just (EVM.VMFailure (EVM.Revert "")) -> io . putStrLn $ - "Reverted" - Just (EVM.VMFailure (EVM.Revert msg)) -> io . putStrLn $ - "Reverted: " <> show (ByteStringS msg) - Just (EVM.VMFailure err) -> io . putStrLn $ - "Failed: " <> show err - Just (EVM.VMSuccess (ConcreteBuffer msg)) -> - if ByteString.null msg - then io $ putStrLn - "Stopped" - else io $ putStrLn $ - "Returned: " <> show (ByteStringS msg) - Just (EVM.VMSuccess (SymbolicBuffer msg)) -> do - out <- mapM (getValue.fromSized) msg - io . putStrLn $ - "Returned: " <> show (ByteStringS (ByteString.pack out)) - -dappCoverage :: UnitTestOptions -> Mode -> String -> IO () -dappCoverage opts _ solcFile = - readSolc solcFile >>= - \case - Just (contractMap, sourceCache) -> do - let unitTests = findUnitTests (EVM.UnitTest.match opts) $ Map.elems contractMap - covs <- mconcat <$> mapM - (coverageForUnitTestContract opts contractMap sourceCache) unitTests - let - dapp = dappInfo "." contractMap sourceCache - f (k, vs) = do - when (shouldPrintCoverage (EVM.UnitTest.covMatch opts) k) $ do - putStr ("\x1b[0m" ++ "————— hevm coverage for ") -- Prefixed with color reset - putStrLn (unpack k ++ " —————") - putStrLn "" - forM_ vs $ \(n, bs) -> do - case ByteString.find (\x -> x /= 0x9 && x /= 0x20 && x /= 0x7d) bs of - Nothing -> putStr "\x1b[38;5;240m" -- Gray (Coverage status isn't relevant) - Just _ -> - case n of - -1 -> putStr "\x1b[38;5;240m" -- Gray (Coverage status isn't relevant) - 0 -> putStr "\x1b[31m" -- Red (Uncovered) - _ -> putStr "\x1b[32m" -- Green (Covered) - Char8.putStrLn bs - putStrLn "" - mapM_ f (Map.toList (coverageReport dapp covs)) - Nothing -> - error ("Failed to read Solidity JSON for `" ++ solcFile ++ "'") - -shouldPrintCoverage :: Maybe Text -> Text -> Bool -shouldPrintCoverage (Just covMatch) file = regexMatches covMatch file -shouldPrintCoverage Nothing file = not (isTestOrLib file) - -isTestOrLib :: Text -> Bool -isTestOrLib file = Text.isSuffixOf ".t.sol" file || areAnyPrefixOf ["src/test/", "src/tests/", "lib/"] file - -areAnyPrefixOf :: [Text] -> Text -> Bool -areAnyPrefixOf prefixes t = any (flip Text.isPrefixOf t) prefixes - -launchExec :: Command Options.Unwrapped -> IO () -launchExec cmd = do - dapp <- getSrcInfo cmd - vm <- vmFromCommand cmd - case optsMode cmd of - Run -> do - vm' <- execStateT (EVM.Stepper.interpret fetcher . void $ EVM.Stepper.execFully) vm - when (trace cmd) $ hPutStr stderr (showTraceTree dapp vm') - case view EVM.result vm' of - Nothing -> - error "internal error; no EVM result" - Just (EVM.VMFailure (EVM.Revert msg)) -> do - print $ ByteStringS msg - exitWith (ExitFailure 2) - Just (EVM.VMFailure err) -> do - print err - exitWith (ExitFailure 2) - Just (EVM.VMSuccess buf) -> do - let msg = case buf of - SymbolicBuffer msg' -> forceLitBytes msg' - ConcreteBuffer msg' -> msg' - print $ ByteStringS msg - case state cmd of - Nothing -> pure () - Just path -> - Git.saveFacts (Git.RepoAt path) (Facts.vmFacts vm') - case cache cmd of - Nothing -> pure () - Just path -> - Git.saveFacts (Git.RepoAt path) (Facts.cacheFacts (view EVM.cache vm')) - - Debug -> void $ EVM.TTY.runFromVM Nothing dapp fetcher vm - JsonTrace -> void $ execStateT (interpretWithTrace fetcher EVM.Stepper.runFully) vm - where fetcher = maybe EVM.Fetch.zero (EVM.Fetch.http block') (rpc cmd) - block' = maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (block cmd) - -data Testcase = Testcase { - _entries :: [(Text, Maybe Text)], - _root :: Text -} deriving Show - -parseTups :: JSON.Value -> JSON.Parser [(Text, Maybe Text)] -parseTups (JSON.Array arr) = do - tupList <- mapM parseJSON (V.toList arr) - mapM (\[k, v] -> do - rhs <- parseJSON v - lhs <- parseJSON k - return (lhs, rhs)) - tupList -parseTups invalid = JSON.typeMismatch "Malformed array" invalid - - -parseTrieTest :: JSON.Object -> JSON.Parser Testcase -parseTrieTest p = do - kvlist <- p .: "in" - entries <- parseTups kvlist - root <- p .: "root" - return $ Testcase entries root - -instance FromJSON Testcase where - parseJSON (JSON.Object p) = parseTrieTest p - parseJSON invalid = JSON.typeMismatch "Merkle test case" invalid - -parseTrieTests :: Lazy.ByteString -> Either String (Map String Testcase) -parseTrieTests = JSON.eitherDecode' - -merkleTest :: Command Options.Unwrapped -> IO () -merkleTest cmd = do - parsed <- parseTrieTests <$> LazyByteString.readFile (file cmd) - case parsed of - Left err -> print err - Right testcases -> mapM_ runMerkleTest testcases - -runMerkleTest :: Testcase -> IO () -runMerkleTest (Testcase entries root) = - case Patricia.calcRoot entries' of - Nothing -> - error "Test case failed" - Just n -> - case n == strip0x (hexText root) of - True -> - putStrLn "Test case success" - False -> - error ("Test case failure; expected " <> show root - <> " but got " <> show (ByteStringS n)) - where entries' = fmap (\(k, v) -> - (tohexOrText k, - tohexOrText (fromMaybe mempty v))) - entries - -tohexOrText :: Text -> ByteString -tohexOrText s = case "0x" `Char8.isPrefixOf` encodeUtf8 s of - True -> hexText s - False -> encodeUtf8 s - --- | Creates a (concrete) VM from command line options -vmFromCommand :: Command Options.Unwrapped -> IO EVM.VM -vmFromCommand cmd = do - withCache <- applyCache (state cmd, cache cmd) - - (miner,ts,baseFee,blockNum,diff) <- case rpc cmd of - Nothing -> return (0,0,0,0,0) - Just url -> EVM.Fetch.fetchBlockFrom block' url >>= \case - Nothing -> error "Could not fetch block" - Just EVM.Block{..} -> return (_coinbase - , wordValue $ forceLit _timestamp - , wordValue _baseFee - , wordValue _number - , wordValue _difficulty - ) - - contract <- case (rpc cmd, address cmd, code cmd) of - (Just url, Just addr', Just c) -> do - EVM.Fetch.fetchContractFrom block' url addr' >>= \case - Nothing -> - error $ "contract not found: " <> show address' - Just contract' -> - -- if both code and url is given, - -- fetch the contract and overwrite the code - return $ - EVM.initialContract (codeType $ hexByteString "--code" $ strip0x c) - & set EVM.storage (view EVM.storage contract') - & set EVM.balance (view EVM.balance contract') - & set EVM.nonce (view EVM.nonce contract') - & set EVM.external (view EVM.external contract') - - (Just url, Just addr', Nothing) -> - EVM.Fetch.fetchContractFrom block' url addr' >>= \case - Nothing -> - error $ "contract not found: " <> show address' - Just contract' -> return contract' - - (_, _, Just c) -> - return $ - EVM.initialContract (codeType $ hexByteString "--code" $ strip0x c) - - (_, _, Nothing) -> - error "must provide at least (rpc + address) or code" - - return $ VMTest.initTx $ withCache (vm0 baseFee miner ts blockNum diff contract) - where - decipher = hexByteString "bytes" . strip0x - block' = maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (block cmd) - value' = word value 0 - caller' = addr caller 0 - origin' = addr origin 0 - calldata' = ConcreteBuffer $ bytes calldata "" - codeType = (if create cmd then EVM.InitCode else EVM.RuntimeCode) . ConcreteBuffer - address' = if create cmd - then addr address (createAddress origin' (word nonce 0)) - else addr address 0xacab - - vm0 baseFee miner ts blockNum diff c = EVM.makeVm $ EVM.VMOpts - { EVM.vmoptContract = c - , EVM.vmoptCalldata = (calldata', litWord (num $ len calldata')) - , EVM.vmoptValue = w256lit value' - , EVM.vmoptAddress = address' - , EVM.vmoptCaller = litAddr caller' - , EVM.vmoptOrigin = origin' - , EVM.vmoptGas = word gas 0 - , EVM.vmoptBaseFee = baseFee - , EVM.vmoptPriorityFee = word priorityFee 0 - , EVM.vmoptGaslimit = word gas 0 - , EVM.vmoptCoinbase = addr coinbase miner - , EVM.vmoptNumber = word number blockNum - , EVM.vmoptTimestamp = w256lit $ word timestamp ts - , EVM.vmoptBlockGaslimit = word gaslimit 0 - , EVM.vmoptGasprice = word gasprice 0 - , EVM.vmoptMaxCodeSize = word maxcodesize 0xffffffff - , EVM.vmoptDifficulty = word difficulty diff - , EVM.vmoptSchedule = FeeSchedule.berlin - , EVM.vmoptChainId = word chainid 1 - , EVM.vmoptCreate = create cmd - , EVM.vmoptStorageModel = ConcreteS - , EVM.vmoptTxAccessList = mempty -- TODO: support me soon - , EVM.vmoptAllowFFI = False - } - word f def = fromMaybe def (f cmd) - addr f def = fromMaybe def (f cmd) - bytes f def = maybe def decipher (f cmd) - -symvmFromCommand :: Command Options.Unwrapped -> Query EVM.VM -symvmFromCommand cmd = do - - (miner,blockNum,baseFee,diff) <- case rpc cmd of - Nothing -> return (0,0,0,0) - Just url -> io $ EVM.Fetch.fetchBlockFrom block' url >>= \case - Nothing -> error "Could not fetch block" - Just EVM.Block{..} -> return (_coinbase - , wordValue _number - , wordValue _baseFee - , wordValue _difficulty - ) - - caller' <- maybe (SAddr <$> freshVar_) (return . litAddr) (caller cmd) - ts <- maybe (var "Timestamp" <$> freshVar_) (return . w256lit) (timestamp cmd) - callvalue' <- maybe (var "CallValue" <$> freshVar_) (return . w256lit) (value cmd) - (calldata', cdlen, pathCond) <- case (calldata cmd, sig cmd) of - -- fully abstract calldata (up to 256 bytes) - (Nothing, Nothing) -> do - cd <- sbytes256 - len' <- freshVar_ - return (SymbolicBuffer cd, var "CALLDATALENGTH" len', (len' .<= 256, Todo "len < 256" [])) - -- fully concrete calldata - (Just c, Nothing) -> - let cd = ConcreteBuffer $ decipher c - in return (cd, litWord (num $ len cd), (sTrue, Todo "" [])) - -- calldata according to given abi with possible specializations from the `arg` list - (Nothing, Just sig') -> do - method' <- io $ functionAbi sig' - let typs = snd <$> view methodInputs method' - (cd, cdlen) <- symCalldata (view methodSignature method') typs (arg cmd) - return (SymbolicBuffer cd, litWord (num cdlen), (sTrue, Todo "" [])) - - _ -> error "incompatible options: calldata and abi" - - store <- case storageModel cmd of - -- InitialS and SymbolicS can read and write to symbolic locations - -- ConcreteS cannot (instead values can be fetched from rpc!) - -- Initial defaults to 0 for uninitialized storage slots, - -- whereas the values of SymbolicS are unconstrained. - Just InitialS -> EVM.Symbolic [] <$> freshArray_ (Just 0) - Just ConcreteS -> return (EVM.Concrete mempty) - Just SymbolicS -> EVM.Symbolic [] <$> freshArray_ Nothing - Nothing -> EVM.Symbolic [] <$> freshArray_ (if create cmd then (Just 0) else Nothing) - - withCache <- io $ applyCache (state cmd, cache cmd) - - contract' <- case (rpc cmd, address cmd, code cmd) of - (Just url, Just addr', _) -> - io (EVM.Fetch.fetchContractFrom block' url addr') >>= \case - Nothing -> - error "contract not found." - Just contract' -> return contract'' - where - contract'' = case code cmd of - Nothing -> contract' - -- if both code and url is given, - -- fetch the contract and overwrite the code - Just c -> EVM.initialContract (codeType $ decipher c) - & set EVM.origStorage (view EVM.origStorage contract') - & set EVM.balance (view EVM.balance contract') - & set EVM.nonce (view EVM.nonce contract') - & set EVM.external (view EVM.external contract') - - (_, _, Just c) -> - return (EVM.initialContract . codeType $ decipher c) - (_, _, Nothing) -> - error "must provide at least (rpc + address) or code" - - return $ (VMTest.initTx $ withCache $ vm0 baseFee miner ts blockNum diff cdlen calldata' callvalue' caller' contract') - & over EVM.constraints (<> [pathCond]) - & set (EVM.env . EVM.contracts . (ix address') . EVM.storage) store - - where - decipher = hexByteString "bytes" . strip0x - block' = maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (block cmd) - origin' = addr origin 0 - codeType = (if create cmd then EVM.InitCode else EVM.RuntimeCode) . ConcreteBuffer - address' = if create cmd - then addr address (createAddress origin' (word nonce 0)) - else addr address 0xacab - vm0 baseFee miner ts blockNum diff cdlen calldata' callvalue' caller' c = EVM.makeVm $ EVM.VMOpts - { EVM.vmoptContract = c - , EVM.vmoptCalldata = (calldata', cdlen) - , EVM.vmoptValue = callvalue' - , EVM.vmoptAddress = address' - , EVM.vmoptCaller = caller' - , EVM.vmoptOrigin = origin' - , EVM.vmoptGas = word gas 0xffffffffffffffff - , EVM.vmoptGaslimit = word gas 0xffffffffffffffff - , EVM.vmoptBaseFee = baseFee - , EVM.vmoptPriorityFee = word priorityFee 0 - , EVM.vmoptCoinbase = addr coinbase miner - , EVM.vmoptNumber = word number blockNum - , EVM.vmoptTimestamp = ts - , EVM.vmoptBlockGaslimit = word gaslimit 0 - , EVM.vmoptGasprice = word gasprice 0 - , EVM.vmoptMaxCodeSize = word maxcodesize 0xffffffff - , EVM.vmoptDifficulty = word difficulty diff - , EVM.vmoptSchedule = FeeSchedule.berlin - , EVM.vmoptChainId = word chainid 1 - , EVM.vmoptCreate = create cmd - , EVM.vmoptStorageModel = fromMaybe SymbolicS (storageModel cmd) - , EVM.vmoptTxAccessList = mempty - , EVM.vmoptAllowFFI = False - } - word f def = fromMaybe def (f cmd) - addr f def = fromMaybe def (f cmd) - -launchTest :: HasCallStack => Command Options.Unwrapped -> IO () -launchTest cmd = do -#if MIN_VERSION_aeson(1, 0, 0) - parsed <- VMTest.parseBCSuite <$> LazyByteString.readFile (file cmd) - case parsed of - Left "No cases to check." -> putStrLn "no-cases ok" - Left err -> print err - Right allTests -> - let testFilter = - if null (test cmd) - then id - else filter (\(x, _) -> elem x (test cmd)) - in - mapM_ (runVMTest (diff cmd) (optsMode cmd) (timeout cmd)) $ - testFilter (Map.toList allTests) -#else - putStrLn "Not supported" -#endif - -#if MIN_VERSION_aeson(1, 0, 0) -runVMTest :: HasCallStack => Bool -> Mode -> Maybe Int -> (String, VMTest.Case) -> IO Bool -runVMTest diffmode mode timelimit (name, x) = - do - let vm0 = VMTest.vmForCase x - putStr (name ++ " ") - hFlush stdout - result <- do - action <- async $ - case mode of - Run -> - Timeout.timeout (1000000 * (fromMaybe 10 timelimit)) $ - execStateT (EVM.Stepper.interpret EVM.Fetch.zero . void $ EVM.Stepper.execFully) vm0 - Debug -> - Just <$> EVM.TTY.runFromVM Nothing emptyDapp EVM.Fetch.zero vm0 - JsonTrace -> - Just <$> execStateT (interpretWithTrace EVM.Fetch.zero EVM.Stepper.runFully) vm0 - waitCatch action - case result of - Right (Just vm1) -> do - ok <- VMTest.checkExpectation diffmode x vm1 - putStrLn (if ok then "ok" else "") - return ok - Right Nothing -> do - putStrLn "timeout" - return False - Left e -> do - putStrLn $ "error: " ++ if diffmode - then show e - else (head . lines . show) e - return False - -#endif - -parseAbi :: (AsValue s) => s -> (Text, [AbiType]) -parseAbi abijson = - (signature abijson, snd - <$> parseMethodInput - <$> V.toList - (fromMaybe (error "Malformed function abi") (abijson ^? key "inputs" . _Array))) - -abiencode :: (AsValue s) => Maybe s -> [String] -> ByteString -abiencode Nothing _ = error "missing required argument: abi" -abiencode (Just abijson) args = - let (sig', declarations) = parseAbi abijson - in if length declarations == length args - then abiMethod sig' $ AbiTuple . V.fromList $ zipWith makeAbiValue declarations args - else error $ "wrong number of arguments:" <> show (length args) <> ": " <> show args diff --git a/src/hevm/hevm.cabal b/src/hevm/hevm.cabal deleted file mode 100644 index 01a978201..000000000 --- a/src/hevm/hevm.cabal +++ /dev/null @@ -1,229 +0,0 @@ -cabal-version: 2.2 -name: - hevm -version: - 0.49.1 -synopsis: - Ethereum virtual machine evaluator -description: - Hevm implements the Ethereum virtual machine semantics. - . - It can be used as a library, and it also comes with an executable - that can run unit test suites, optionally with a visual TTY debugger. -homepage: - https://github.com/dapphub/dapptools -license: - AGPL-3.0-only -license-file: - COPYING -author: - Mikael Brockman, Martin Lundfall -maintainer: - mikael@brockman.se, martin.lundfall@gmail.com -category: - Ethereum -build-type: - Simple -data-files: - run-blockchain-tests - run-consensus-tests -extra-source-files: - CHANGELOG.md - -library - exposed-modules: - EVM, - EVM.ABI, - EVM.Concrete, - EVM.Dapp, - EVM.Dev, - EVM.Debug, - EVM.Demand, - EVM.Emacs, - EVM.Exec, - EVM.Facts, - EVM.Facts.Git, - EVM.Flatten, - EVM.Format, - EVM.Fetch, - EVM.FeeSchedule, - EVM.Hexdump, - EVM.Op, - EVM.Patricia, - EVM.Precompiled, - EVM.RLP, - EVM.Solidity, - EVM.Stepper, - EVM.StorageLayout, - EVM.Symbolic, - EVM.SymExec - EVM.Transaction, - EVM.TTY, - EVM.TTYCenteredList, - EVM.Types, - EVM.UnitTest, - EVM.VMTest - other-modules: - Paths_hevm - autogen-modules: - Paths_hevm - ghc-options: - -Wall -Wno-deprecations - extra-libraries: - secp256k1, ff - c-sources: - ethjet/tinykeccak.c, ethjet/ethjet.c - cxx-sources: - ethjet/ethjet-ff.cc, ethjet/blake2.cc - cxx-options: - -std=c++0x - install-includes: - ethjet/tinykeccak.h, ethjet/ethjet.h, ethjet/ethjet-ff.h, ethjet/blake2.h - build-depends: - QuickCheck >= 2.13.2 && < 2.15, - Decimal >= 0.5.1 && < 0.6, - containers >= 0.6.0 && < 0.7, - deepseq >= 1.4.4 && < 1.5, - time >= 1.8.0 && < 1.11, - transformers >= 0.5.6 && < 0.6, - tree-view >= 0.5 && < 0.6, - abstract-par >= 0.3.3 && < 0.4, - aeson >= 1.5.6 && < 1.6, - bytestring >= 0.10.8 && < 0.11, - scientific >= 0.3.6 && < 0.4, - binary >= 0.8.6 && < 0.9, - text >= 1.2.3 && < 1.3, - unordered-containers >= 0.2.10 && < 0.3, - vector >= 0.12.1 && < 0.13, - ansi-wl-pprint >= 0.6.9 && < 0.7, - base16-bytestring >= 1.0.0 && < 2.0, - brick >= 0.58 && < 0.63, - megaparsec >= 9.0.0 && < 10.0, - mtl >= 2.2.2 && < 2.3, - directory >= 1.3.3 && < 1.4, - filepath >= 1.4.2 && < 1.5, - vty >= 5.25.1 && < 5.34, - cereal >= 0.5.8 && < 0.6, - cryptonite >= 0.27 && <= 0.29, - memory >= 0.14.18 && < 0.16, - data-dword >= 0.3.1 && < 0.4, - fgl >= 5.7.0 && < 5.8, - free >= 5.1.3 && < 5.2, - haskeline >= 0.8.0 && < 0.9, - process >= 1.6.5 && < 1.7, - lens >= 4.17.1 && < 4.20, - lens-aeson >= 1.0.2 && < 1.2, - monad-par >= 0.3.5 && < 0.4, - multiset >= 0.3.4 && < 0.4, - operational >= 0.2.3 && < 0.3, - optparse-generic >= 1.3.1 && < 1.5, - quickcheck-text >= 0.1.2 && < 0.2, - restless-git >= 0.7 && < 0.8, - rosezipper >= 0.2 && < 0.3, - s-cargot >= 0.1.4 && < 0.2, - sbv >= 8.9, - semver-range >= 0.2.7 && < 0.3, - temporary >= 1.3 && < 1.4, - text-format >= 0.3.2 && < 0.4, - witherable >= 0.3.5 && < 0.5, - wreq >= 0.5.3 && < 0.6, - regex-tdfa >= 1.2.3 && < 1.4, - base >= 4.9 && < 5, - here >= 1.2.13 && < 1.3, - hs-source-dirs: - src - default-language: - Haskell2010 - default-extensions: - BangPatterns, - DeriveDataTypeable, - DeriveGeneric, - FlexibleContexts, - GeneralizedNewtypeDeriving, - LambdaCase, - OverloadedStrings, - Rank2Types, - RecordWildCards, - TypeFamilies, - ViewPatterns - -executable hevm - default-language: - Haskell2010 - hs-source-dirs: - hevm-cli - main-is: - hevm-cli.hs - ghc-options: - -Wall -threaded -with-rtsopts=-N - other-modules: - Paths_hevm - if os(darwin) - ld-options: -Wl,-keep_dwarf_unwind - build-depends: - QuickCheck, - aeson, - ansi-wl-pprint, - async, - base, - base16-bytestring, - binary, - brick, - bytestring, - containers, - cryptonite, - data-dword, - deepseq, - directory, - filepath, - free, - hevm, - lens, - lens-aeson, - memory, - mtl, - optparse-generic, - operational, - process, - quickcheck-text, - regex-tdfa, - sbv, - temporary, - text, - text-format, - unordered-containers, - vector, - vty - -test-suite test - default-language: - Haskell2010 - ghc-options: - -Wall - type: - exitcode-stdio-1.0 - hs-source-dirs: - test - main-is: - test.hs - extra-libraries: - secp256k1 - build-depends: - HUnit >= 1.6, - QuickCheck, - base, - base16-bytestring, - binary, - containers, - bytestring, - free, - here, - hevm, - lens, - mtl, - tasty >= 1.0, - tasty-hunit >= 0.10, - tasty-quickcheck >= 0.9, - text, - vector, - sbv diff --git a/src/hevm/hevm.el b/src/hevm/hevm.el deleted file mode 100644 index a83e25c6a..000000000 --- a/src/hevm/hevm.el +++ /dev/null @@ -1,322 +0,0 @@ -;; -;; hevm.el -;; - -(defgroup hevm nil - "Hevm, the amazing EVM debugger") - -(defcustom hevm-executable-path nil - "How to find the hevm executable" - :type '(choice (const :tag "Find hevm automatically" nil) - (file :tag "Use a specific binary"))) - -(defun hevm-get-executable-path () - "Return the path to use for the hevm executable" - (let ((path (if (null hevm-executable-path) - (executable-find "hevm") - hevm-executable-path))) - (if (file-executable-p path) - path - (if (null hevm-executable-path) - (error - "hevm executable not found; maybe customize `hevm-executable-path'") - (error - "hevm executable not found in `%s'; maybe customize `hevm-executable-path'" - hevm-executable-path))))) - -(defvar hevm-root nil - "Root path of the currently debugged dapp.") - -(defvar hevm-buffer nil - "Process buffer used to communicate with hevm.") - -(defvar hevm-stack-buffer nil - "Buffer that displays the current VM's word stack.") - -(defvar hevm-waiting nil - "Are we waiting for the previous command to finish?") - -(defvar hevm-plan '() - "When the next prompt is ready, we pop the head of this list -and send it as input.") - -(defvar hevm-should-setup nil - "Are we just about to set up the Hevm debugging layout?") - -(defvar hevm-dapp-info nil - "Serialized DappInfo structure for the current dapp.") - -(defvar hevm-unit-tests nil - "List of unit tests for the current dapp.") - -(defvar hevm-vm nil - "The latest VM structure during debugging.") - -(defvar hevm-source-map-overlay nil - "Overlay that moves around in the debugged source code buffers.") - -(define-derived-mode hevm-mode comint-mode "Hevm" - "Major mode for `hevm'." - nil "Hevm" - (setq comint-prompt-regexp "^> ") - (setq comint-prompt-read-only t) - (add-hook 'comint-output-filter-functions 'hevm-output-filter)) - -(defun hevm (root json-file) - "Start a Hevm debugging session for a given dapp." - (interactive "DDapp root: \nfJSON file: ") - (when (get-buffer "*hevm*") - (kill-buffer "*hevm*")) - (let ((buffer (get-buffer-create "*hevm*"))) - (setq hevm-plan - `((load-dapp ,(expand-file-name root) ,(expand-file-name json-file)))) - (setq hevm-waiting t) - (make-comint-in-buffer "Hevm" buffer (hevm-get-executable-path) nil "emacs") - (with-current-buffer buffer (hevm-mode)) - (setq hevm-buffer buffer) - (message "Hevm started."))) - -(add-hook 'hevm-mode-hook 'hevm-initialize) -(defun hevm-initialize () - "Do Hevm comint minor mode initialization stuff." - (setq comint-process-echoes t) - (setq comint-use-prompt-regexp t)) - -(defun hevm-send (input) - "Send a command to the Hevm process." - (if hevm-waiting - (push input hevm-plan) - (with-current-buffer hevm-buffer - (goto-char (point-max)) - (insert (prin1-to-string input)) - (setq hevm-waiting t) - (comint-send-input nil t)))) - -(defmacro hevm-define-command (name help command) - "Define a simple Hevm command-sending function." - (declare (indent defun)) - `(defun ,name () - ,help - (interactive) - (hevm-send ,command))) - -(hevm-define-command hevm-do-step-once - "Step forward by one opcode." - '(step "once")) - -(hevm-define-command hevm-do-step-to-next-source-location - "Step forward until the source location changes." - '(step "source-location")) - -(hevm-define-command hevm-do-step-to-file-line - "Step forward until the source location visits a specific source line." - (let ((wanted-file-name (file-relative-name (buffer-file-name) hevm-root)) - (wanted-line-number (line-number-at-pos))) - `(step ("file-line" ,wanted-file-name ,wanted-line-number)))) - -(define-minor-mode hevm-debug-mode - "Hevm debug minor mode." - nil - " Hevm" - '(("n" . hevm-do-step-once) - ("N" . hevm-do-step-to-next-source-location) - ("!" . hevm-do-step-to-file-line) - ("c" . hevm-browse-contracts) - ("q" . quit-window)) - :group 'hevm) - -(define-minor-mode hevm-browse-contracts-mode - "Hevm contract browser minor mode." - nil - " Hevm-Contracts" - '(("q" . quit-window)) - :group 'hevm) - -(defun hevm-get-bytecode-buffer (codehash) - (let ((buffer (get-buffer-create (format "*hevm bytecode %s*" codehash)))) - (with-current-buffer buffer - (when (equal 0 (buffer-size buffer)) - (insert "(no bytecode)"))) - buffer)) - -(defun hevm-add-bytecode-buffers (codes) - (dolist (item codes) - (let ((codehash (car item)) - (code (cadr item))) - (with-current-buffer (hevm-get-bytecode-buffer codehash) - (delete-region (point-min) (point-max)) - (insert (format "%s" code)))))) - -(defun hevm-output-filter (string) - "Hook for the Hevm process output." - ;; Does the readline prompt occur in the output? - ;; If so, we should process all the output before it. - (when (string-match comint-prompt-regexp string) - (setq hevm-waiting nil) - (save-excursion - (with-current-buffer hevm-buffer - (comint-previous-prompt 1) - (beginning-of-line) - (let ((have-something-to-do (looking-at comint-prompt-regexp))) - (when have-something-to-do - (forward-line 1) - (save-excursion - (hevm-handle-output (read hevm-buffer))) - (kill-sexp) - (insert ";; [redacted]")))))) - (hevm-follow-plan) - (comint-next-prompt 1)) - -(defun hevm-handle-output (thing) - "React to a Hevm process output s-expression." - (pcase thing - - ;; Incoming dapp load confirmation with unit test list. - (`(dapp-info (root ,root) (unit-tests . ,tests)) - (setq hevm-root (file-name-as-directory root)) - (setq hevm-unit-tests tests) - (run-with-idle-timer 0 nil #'hevm-run-test)) - - ;; Incoming new VM step information. - (`(step (vm ,vm) (file ,file) (srcmap ,offset ,length ,jump-type) (newCodes ,new-codes)) - (hevm-add-bytecode-buffers new-codes) - (hevm-update vm) - (find-file-read-only (concat hevm-root file)) - (hevm-debug-mode) - (goto-char (+ 1 offset)) - (hevm-highlight-source-region offset length jump-type) - (recenter) - (when hevm-should-setup - (setq hevm-should-setup nil) - (delete-other-windows) - (select-window (split-window nil -10 'above)) - (switch-to-buffer hevm-stack-buffer) - (select-window (split-window nil nil 'right)) - (generate-new-buffer "*hevm bytecode placeholder*") - (other-window -2))) - - ;; Incoming new VM step information without srcmap - (`(step (vm ,vm) (newCodes ,new-codes)) - (hevm-add-bytecode-buffers new-codes) - (hevm-update vm) - (hevm-highlight-source-region 0 0 'JumpRegular) - (message "No srcmap!")) - - ;; We sent some command that Hevm didn't understand. - ('(unrecognized-command) - (error "Unrecognized Hevm input command.")) - - ;; We got some weird stuff from Hevm. - (_ - (message "Unknown Hevm output: %S" thing)))) - -(defun hevm-follow-plan () - "Pop and send a command from the Hevm plan queue, if possible." - (when hevm-plan - (hevm-send (car hevm-plan)) - (setq hevm-plan (cdr hevm-plan)))) - -(defun hevm-run-test () - "Pick a dapp unit test and load it into Hevm." - (interactive) - (let* ((contract-name - (completing-read - "Contract: " - (mapcar #'car hevm-unit-tests))) - (test - (completing-read - "Unit test: " - (cadr (assoc contract-name hevm-unit-tests))))) - (setq hevm-should-setup t) - (hevm-send `(run-test ,contract-name ,test)))) - -(defun hevm-highlight-source-region (offset length jump-type) - "Move the Hevm source map overlay to some range in the current buffer." - (let* ((start (+ 1 offset)) - (end (+ length start)) - (color (pcase jump-type - ('JumpInto "lightgreen") - ('JumpRegular nil) - ('JumpFrom "lightblue")))) - (message color) - (if hevm-source-map-overlay - (move-overlay hevm-source-map-overlay start end (current-buffer)) - (setq hevm-source-map-overlay - (make-overlay start end (current-buffer)))) - (overlay-put hevm-source-map-overlay - 'face - `((weight . "bold") - (background-color . ,color))))) - -(defun hevm-get-current-codehash (vm) - (let* ((contracts (cadr (assoc 'contracts vm))) - (state (cadr (assoc 'state vm))) - (code-contract (cadr (assoc 'code-contract state))) - (contract (cadr (assoc code-contract contracts))) - (codehash (cadr (assoc 'codehash contract)))) - codehash)) - -(defun hevm-update (vm) - "Use a new EVM state and update live buffers like the stack viewer and bytecode viewer." - (setq hevm-vm vm) - (setq hevm-stack-buffer (get-buffer-create "*hevm stack*")) - (setq hevm-bytecode-buffer (get-buffer-create "*hevm bytecode*")) - (let* ((state (cadr (assoc 'state hevm-vm))) - (stack (cadr (assoc 'stack state))) - (pc (cadr (assoc 'pc state))) - (bytecode-buffer (hevm-get-bytecode-buffer (hevm-get-current-codehash vm)))) - (with-current-buffer hevm-stack-buffer - (delete-region (point-min) (point-max)) - (let ((i 1)) - (dolist (word stack) - (insert (format "(%S) %S\n" i word)) - (setf i (+ i 1))))) - (when (get-buffer-window hevm-stack-buffer) - (with-selected-window (get-buffer-window hevm-stack-buffer) - ;; find the previous bytecode window - (other-window 1) - ;; point it to the current bytecode - (switch-to-buffer bytecode-buffer) - ;; find the line with the pc (optimised search) - (if (not (search-forward (format "%02x " pc) nil t nil)) - (search-backward (format "%02x " pc) nil t nil)) - (beginning-of-line) - (recenter))))) - -(defun hevm-browse-contracts () - "Open a buffer that lists all the contracts in the current EVM. -This buffer is non-live; you have to refresh it to see new state." - (interactive) - (let ((buffer (get-buffer-create "*hevm contracts*"))) - (switch-to-buffer buffer) - (read-only-mode 1) - (let ((inhibit-read-only t)) - (delete-region (point-min) (point-max)) - (org-mode) - (hevm-browse-contracts-mode) - (dolist (contract (cadr (assoc 'contracts hevm-vm))) - (let* ((address (car contract)) - (fields (cadr contract)) - (storage (cadr (assoc 'storage fields))) - (balance (cadr (assoc 'balance fields))) - (nonce (cadr (assoc 'nonce fields))) - (codehash (cadr (assoc 'codehash fields)))) - (insert "* " address "\n") - (insert " Balance: " balance "\n") - (insert " Nonce: " nonce "\n") - (insert " Codehash: " codehash "\n") - (when storage - (insert "\n** Storage\n") - (dolist (x storage) - (pcase (car x) - (`(hash ,k ,bs) - (insert " - " - (format "%S" k) " = " (cadr x) "\n") - ;; Insert the hash preimage. - ;; This isn't so useful right now. - ;; Hevm needs better preimage tracking. - (insert " [" bs "]")) - (_ - (insert " - " (car x) " = " (cadr x) "\n"))))) - (insert "\n")))) - (goto-char (point-min)))) diff --git a/src/hevm/hie.yaml b/src/hevm/hie.yaml deleted file mode 100644 index 2dca4ec9d..000000000 --- a/src/hevm/hie.yaml +++ /dev/null @@ -1,8 +0,0 @@ -cradle: - cabal: - - path: "./src" - component: "lib:hevm" - - path: "./hevm-cli" - component: "exe:hevm" - - path: "./test" - component: "test:test" diff --git a/src/hevm/run-blockchain-tests b/src/hevm/run-blockchain-tests deleted file mode 100755 index b97f2cad6..000000000 --- a/src/hevm/run-blockchain-tests +++ /dev/null @@ -1,150 +0,0 @@ -#!/usr/bin/env bash -set -e - -# Invoke with hevm e.g. -# hevm compliance --tests ~/ethereum-tests --skip modexp --timeout 20 --html - -HEVM=${HEVM:-hevm} - -if [[ "$#" -lt 1 ]]; then - echo >&2 "usage: $(basename "$0") " - exit 1 -fi - -tests=$1 -html=$2 -match=$3 -skip=$4 -timeout=${5:-10} - -_html () { -cat <<. - -hevm test results - -
-

hevm consensus test report

-

$(date +%Y-%m-%d)

-

$(echo "$npass passed, $nbal bad-balance, $nnon bad-nonce, $nstr bad-storage, $nfail failed, $nskip skipped, $ntime timeout")

-(Test suite: GeneralStateTests for Berlin) -
-

Failed tests

- - -$(echo $noncefailed) -$(echo $storagefailed) -$(echo $failed) -
-

Failed tests (due to balance only)

- - -$(echo $balancefailed) -
-

Timeout tests

- - -$(echo $timeouts) -
-

Skipped tests

- - -$(echo $skipped) -
-

Passed tests

- - -$(echo $passed) -
-. -} - -shopt -s nocasematch -{ - cd "$tests" - for x in BlockchainTests/GeneralStateTests/*/*; do - if [ -d $x ]; then - for y in $x/*; do - if [[ $y =~ .*$match.* ]] && [[ -n $skip && $y =~ .*$skip.* ]]; then - for job in $(<$y jq '.|keys[]' -r); do - echo -n "$job " ; echo "skip" - done - elif [[ $y =~ .*$match.* ]]; then - set +e - "$HEVM" bc-test --file $y --timeout $timeout 2>&1 - set -e - fi - done - else - if [[ $x =~ .*$match.* ]] && [[ -n $skip && $x =~ .*$skip.* ]]; then - for job in $(<$x jq '.|keys[]' -r); do - echo -n "$job " ; echo "skip" - done - elif [[ $x =~ .*$match.* ]]; then - set +e - "$HEVM" bc-test --file $x --timeout $timeout 2>&1 - set -e - fi - fi - done -} | { - while read test outcome; do - echo >&2 "$test $outcome" - row="$test$outcome" - row+=$'\n' - case $outcome in - ok) passed+=$row ;; - bad-balance) balancefailed+=$row ;; - bad-nonce) noncefailed+=$row ;; - bad-storage) storagefailed+=$row ;; - timeout) timeouts+=$row ;; - skip) skipped+=$row ;; - *) failed+=$row ;; - esac - done - - sum () { echo -ne "$1" | wc -l | awk '{print $1}'; } - - npass=$(sum "$passed") - nbal=$(sum "$balancefailed") - nnon=$(sum "$noncefailed") - nstr=$(sum "$storagefailed") - nfail=$(sum "$failed") - ntime=$(sum "$timeouts") - nskip=$(sum "$skipped") - - echo >&2 "passed: $npass" - echo >&2 "bad-balance: $nbal" - echo >&2 "bad-nonce: $nnon" - echo >&2 "bad-storage: $nstr" - echo >&2 "failed: $nfail" - echo >&2 "timeout: $ntime" - echo >&2 "skipped: $nskip" - - if [[ $html == "True" ]]; then - _html - fi - - nbad=$(($nbal + $nnon + $nstr + $nfail)) - - [[ $nbad -gt 0 ]] && exit 1 || exit 0 -} diff --git a/src/hevm/run-consensus-tests b/src/hevm/run-consensus-tests deleted file mode 100755 index b183b679e..000000000 --- a/src/hevm/run-consensus-tests +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/env bash -set -e - -# Invoke with hevm e.g. -# hevm compliance --tests ~/ethereum-tests --group VM --skip quadratic --html - -HEVM=${HEVM:-hevm} - -if [[ "$#" -lt 1 ]]; then - echo >&2 "usage: $(basename "$0") " - exit 1 -fi - -tests=$1 -html=$2 -match=$3 -skip=$4 -timeout=${5:-10} - -_html() { -cat <<. - -hevm test results - -
-

hevm consensus test report

-

$(date +%Y-%m-%d)

-

$(echo "$npass passed, $nfail failed, $nskip skipped")

-(Test suite: VMTests for ConstantinopleFix) -
-

Failed tests

- - -$(echo $failed) -
-

Skipped tests

- - -$(echo $skipped) -
-

Passed tests

- - -$(echo $passed) -
-. -} - -{ - cd "$tests" - for x in VMTests/*/*; do - if [[ $x =~ .*$match.* ]] && [[ -n $skip && $x =~ .*$skip.* ]]; then - for job in $(<$x jq '.|keys[]' -r); do - echo "$x $job skip" - done - elif [[ $x =~ .*$match.* ]]; then - echo -n "$x " ; "$HEVM" vm-test --file $x --timeout $timeout 2>&1 - fi - done -} | { - while read path test outcome; do - echo >&2 "$path $test $outcome" - category=$(dirname "$path") - testcase=$(basename "${path%.json}") - row="$testcase$outcome$category" - row+=$'\n' - case $outcome in - ok) passed+=$row ;; - skip) skipped+=$row ;; - timeout) timouts+=row ;; - *) failed+=$row ;; - esac - done - - sum () { echo -ne "$1" | wc -l | awk '{print $1}'; } - - nfail=$(sum "$failed") - npass=$(sum "$passed") - nskip=$(sum "$skipped") - ntime=$(sum "$timeouts") - - echo >&2 "passed: $npass" - echo >&2 "failed: $nfail" - echo >&2 "timeout: $ntime" - echo >&2 "skipped: $nskip" - - if [[ $html == "True" ]]; then - _html - fi - - [[ $nfail -gt 0 ]] && exit 1 || exit 0 -} diff --git a/src/hevm/shell.nix b/src/hevm/shell.nix deleted file mode 100644 index d3ed04b0c..000000000 --- a/src/hevm/shell.nix +++ /dev/null @@ -1,21 +0,0 @@ -{ dapphub ? import ../.. {} }: -let - inherit (dapphub) pkgs; - - - drv = pkgs.haskellPackages.shellFor { - packages = p: [ - p.hevm - ]; - buildInputs = with pkgs.haskellPackages; [ - cabal-install - haskell-language-server - ]; - withHoogle = true; - }; -in - if pkgs.lib.inNixShell - then drv.overrideAttrs (_: { - LD_LIBRARY_PATH = "${pkgs.secp256k1}/lib:${pkgs.libff}/lib"; - }) - else drv diff --git a/src/hevm/src/EVM.hs b/src/hevm/src/EVM.hs deleted file mode 100644 index 830515db2..000000000 --- a/src/hevm/src/EVM.hs +++ /dev/null @@ -1,2870 +0,0 @@ -{-# Language ImplicitParams #-} -{-# Language ConstraintKinds #-} -{-# Language FlexibleInstances #-} -{-# Language DataKinds #-} -{-# Language GADTs #-} -{-# Language RecordWildCards #-} -{-# Language ScopedTypeVariables #-} -{-# Language StandaloneDeriving #-} -{-# Language StrictData #-} -{-# Language TemplateHaskell #-} -{-# Language TypeOperators #-} -{-# Language ViewPatterns #-} - -module EVM where - -import Prelude hiding (log, Word, exponent, GT, LT) - -import Data.SBV hiding (Word, output, Unknown) -import Data.Proxy (Proxy(..)) -import Data.Text (unpack) -import Data.Text.Encoding (decodeUtf8, encodeUtf8) -import qualified Data.Vector as V -import EVM.ABI -import EVM.Types -import EVM.Solidity -import EVM.Concrete (createAddress, wordValue, keccakBlob, create2Address, readMemoryWord) -import EVM.Symbolic -import EVM.Op -import EVM.FeeSchedule (FeeSchedule (..)) -import Options.Generic as Options -import qualified EVM.Precompiled - -import Control.Lens hiding (op, (:<), (|>), (.>)) -import Control.Monad.State.Strict hiding (state) - -import Data.ByteString (ByteString) -import Data.ByteString.Lazy (fromStrict) -import Data.Map.Strict (Map) -import Data.Set (Set, insert, member, fromList) -import Data.Maybe (fromMaybe) -import Data.Sequence (Seq) -import Data.Vector.Storable (Vector) -import Data.Foldable (toList) - -import Data.Tree -import Data.List (find) - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LS -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.ByteArray as BA -import qualified Data.Map.Strict as Map -import qualified Data.Sequence as Seq -import qualified Data.Tree.Zipper as Zipper -import qualified Data.Vector as V -import qualified Data.Vector.Storable as Vector -import qualified Data.Vector.Storable.Mutable as Vector - -import qualified Data.Vector as RegularVector - -import Crypto.Number.ModArithmetic (expFast) -import qualified Crypto.Hash as Crypto -import Crypto.Hash (Digest, SHA256, RIPEMD160, digestFromByteString) -import Crypto.PubKey.ECC.ECDSA (signDigestWith, PrivateKey(..), Signature(..)) -import Crypto.PubKey.ECC.Types (getCurveByName, CurveName(..), Point(..)) -import Crypto.PubKey.ECC.Generate (generateQ) - --- * Data types - --- | EVM failure modes -data Error - = BalanceTooLow Word Word - | UnrecognizedOpcode Word8 - | SelfDestruction - | StackUnderrun - | BadJumpDestination - | Revert ByteString - | OutOfGas Word Word - | BadCheatCode (Maybe Word32) - | StackLimitExceeded - | IllegalOverflow - | Query Query - | Choose Choose - | StateChangeWhileStatic - | InvalidMemoryAccess - | CallDepthLimitReached - | MaxCodeSizeExceeded Word Word - | InvalidFormat - | PrecompileFailure - | UnexpectedSymbolicArg - | DeadPath - | NotUnique Whiff - | SMTTimeout - | FFI AbiVals -deriving instance Show Error - --- | The possible result states of a VM -data VMResult - = VMFailure Error -- ^ An operation failed - | VMSuccess Buffer -- ^ Reached STOP, RETURN, or end-of-code - -deriving instance Show VMResult - --- | The state of a stepwise EVM execution -data VM = VM - { _result :: Maybe VMResult - , _state :: FrameState - , _frames :: [Frame] - , _env :: Env - , _block :: Block - , _tx :: TxState - , _logs :: Seq Log - , _traces :: Zipper.TreePos Zipper.Empty Trace - , _cache :: Cache - , _burned :: Word - , _constraints :: [(SBool, Whiff)] - , _iterations :: Map CodeLocation Int - , _allowFFI :: Bool - } - deriving (Show) - -data Trace = Trace - { _traceOpIx :: Int - , _traceContract :: Contract - , _traceData :: TraceData - } - deriving (Show) - -data TraceData - = EventTrace Log - | FrameTrace FrameContext - | QueryTrace Query - | ErrorTrace Error - | EntryTrace Text - | ReturnTrace Buffer FrameContext - deriving (Show) - --- | Queries halt execution until resolved through RPC calls or SMT queries -data Query where - PleaseFetchContract :: Addr -> StorageModel -> (Contract -> EVM ()) -> Query - PleaseMakeUnique :: SymVal a => SBV a -> [SBool] -> (IsUnique a -> EVM ()) -> Query - PleaseFetchSlot :: Addr -> Word -> (Word -> EVM ()) -> Query - PleaseAskSMT :: SBool -> [SBool] -> (BranchCondition -> EVM ()) -> Query - PleaseDoFFI :: [String] -> (ByteString -> EVM ()) -> Query - -data Choose where - PleaseChoosePath :: Whiff -> (Bool -> EVM ()) -> Choose - -instance Show Query where - showsPrec _ = \case - PleaseFetchContract addr _ _ -> - (("") ++) - PleaseFetchSlot addr slot _ -> - (("") ++) - PleaseAskSMT condition constraints _ -> - (("") ++) - PleaseMakeUnique val constraints _ -> - (("") ++) - PleaseDoFFI cmd _ -> - ((" - ((" b = Cache - { _fetched = Map.unionWith unifyCachedContract (view fetched a) (view fetched b) - , _path = mappend (view path a) (view path b) - } - --- only intended for use in Cache merges, where we expect --- everything to be Concrete -unifyCachedContract :: Contract -> Contract -> Contract -unifyCachedContract a b = a & set storage merged - where merged = case (view storage a, view storage b) of - (Concrete sa, Concrete sb) -> - Concrete (mappend sa sb) - _ -> - view storage a - -instance Monoid Cache where - mempty = Cache { _fetched = mempty, - _path = mempty - } - --- * Data accessors - -currentContract :: VM -> Maybe Contract -currentContract vm = - view (env . contracts . at (view (state . codeContract) vm)) vm - --- * Data constructors - -makeVm :: VMOpts -> VM -makeVm o = - let txaccessList = vmoptTxAccessList o - txorigin = vmoptOrigin o - txtoAddr = vmoptAddress o - initialAccessedAddrs = fromList $ [txorigin, txtoAddr] ++ [1..9] ++ (Map.keys txaccessList) - initialAccessedStorageKeys = fromList $ foldMap (uncurry (map . (,))) (Map.toList txaccessList) - touched = if vmoptCreate o then [txorigin] else [txorigin, txtoAddr] - in - VM - { _result = Nothing - , _frames = mempty - , _tx = TxState - { _gasprice = w256 $ vmoptGasprice o - , _txgaslimit = w256 $ vmoptGaslimit o - , _txPriorityFee = w256 $ vmoptPriorityFee o - , _origin = txorigin - , _toAddr = txtoAddr - , _value = vmoptValue o - , _substate = SubState mempty touched initialAccessedAddrs initialAccessedStorageKeys mempty - --, _accessList = txaccessList - , _isCreate = vmoptCreate o - , _txReversion = Map.fromList - [(vmoptAddress o, vmoptContract o)] - } - , _logs = mempty - , _traces = Zipper.fromForest [] - , _block = Block - { _coinbase = vmoptCoinbase o - , _timestamp = vmoptTimestamp o - , _number = w256 $ vmoptNumber o - , _difficulty = w256 $ vmoptDifficulty o - , _maxCodeSize = w256 $ vmoptMaxCodeSize o - , _gaslimit = w256 $ vmoptBlockGaslimit o - , _baseFee = w256 $ vmoptBaseFee o - , _schedule = vmoptSchedule o - } - , _state = FrameState - { _pc = 0 - , _stack = mempty - , _memory = mempty - , _memorySize = 0 - , _code = theCode - , _contract = vmoptAddress o - , _codeContract = vmoptAddress o - , _calldata = vmoptCalldata o - , _callvalue = vmoptValue o - , _caller = vmoptCaller o - , _gas = w256 $ vmoptGas o - , _returndata = mempty - , _static = False - } - , _env = Env - { _sha3Crack = mempty - , _chainId = w256 $ vmoptChainId o - , _contracts = Map.fromList - [(vmoptAddress o, vmoptContract o)] - , _keccakUsed = mempty - , _storageModel = vmoptStorageModel o - } - , _cache = Cache mempty mempty - , _burned = 0 - , _constraints = [] - , _iterations = mempty - , _allowFFI = vmoptAllowFFI o - } where theCode = case _contractcode (vmoptContract o) of - InitCode b -> b - RuntimeCode b -> b - --- | Initialize empty contract with given code -initialContract :: ContractCode -> Contract -initialContract theContractCode = Contract - { _contractcode = theContractCode - , _codehash = - case theCode of - ConcreteBuffer b -> keccak (stripBytecodeMetadata b) - SymbolicBuffer _ -> 0 - - , _storage = Concrete mempty - , _balance = 0 - , _nonce = if creation then 1 else 0 - , _opIxMap = mkOpIxMap theCode - , _codeOps = mkCodeOps theCode - , _external = False - , _origStorage = mempty - } where - (creation, theCode) = case theContractCode of - InitCode b -> (True, b) - RuntimeCode b -> (False, b) - -contractWithStore :: ContractCode -> Storage -> Contract -contractWithStore theContractCode store = - initialContract theContractCode & set storage store - --- * Opcode dispatch (exec1) - --- | Update program counter -next :: (?op :: Word8) => EVM () -next = modifying (state . pc) (+ (opSize ?op)) - --- | Executes the EVM one step -exec1 :: EVM () -exec1 = do - vm <- get - - let - -- Convenience function to access parts of the current VM state. - -- Arcane type signature needed to avoid monomorphism restriction. - the :: (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a - the f g = view (f . g) vm - - -- Convenient aliases - mem = the state memory - stk = the state stack - self = the state contract - this = fromMaybe (error "internal error: state contract") (preview (ix self) (the env contracts)) - - fees@FeeSchedule {..} = the block schedule - - doStop = finishFrame (FrameReturned mempty) - - if self > 0x0 && self <= 0x9 then do - -- call to precompile - let ?op = 0x00 -- dummy value - let - calldatasize = snd (the state calldata) - case maybeLitWord calldatasize of - Nothing -> vmError UnexpectedSymbolicArg - Just calldatasize' -> do - copyBytesToMemory (fst $ the state calldata) (num calldatasize') 0 0 - executePrecompile self (num $ the state gas) 0 (num calldatasize') 0 0 [] - vmx <- get - case view (state.stack) vmx of - (x:_) -> case maybeLitWord x of - Just 0 -> do - fetchAccount self $ \_ -> do - touchAccount self - vmError PrecompileFailure - Just _ -> - fetchAccount self $ \_ -> do - touchAccount self - out <- use (state . returndata) - finishFrame (FrameReturned out) - Nothing -> vmError UnexpectedSymbolicArg - _ -> - underrun - - else if the state pc >= len (the state code) - then doStop - - else do - let ?op = fromMaybe (error "could not analyze symbolic code") $ unliteral $ EVM.Symbolic.index (the state pc) (the state code) - - case ?op of - - -- op: PUSH - x | x >= 0x60 && x <= 0x7f -> do - let !n = num x - 0x60 + 1 - !xs = case the state code of - ConcreteBuffer b -> w256lit $ word $ padRight n $ BS.take n (BS.drop (1 + the state pc) b) - SymbolicBuffer b -> readSWord' 0 $ padLeft' 32 $ take n $ drop (1 + the state pc) b - limitStack 1 $ - burn g_verylow $ do - next - pushSym xs - - -- op: DUP - x | x >= 0x80 && x <= 0x8f -> do - let !i = x - 0x80 + 1 - case preview (ix (num i - 1)) stk of - Nothing -> underrun - Just y -> - limitStack 1 $ - burn g_verylow $ do - next - pushSym y - - -- op: SWAP - x | x >= 0x90 && x <= 0x9f -> do - let i = num (x - 0x90 + 1) - if length stk < i + 1 - then underrun - else - burn g_verylow $ do - next - zoom (state . stack) $ do - assign (ix 0) (stk ^?! ix i) - assign (ix i) (stk ^?! ix 0) - - -- op: LOG - x | x >= 0xa0 && x <= 0xa4 -> - notStatic $ - let n = (num x - 0xa0) in - case stk of - (xOffset':xSize':xs) -> - if length xs < n - then underrun - else - forceConcrete2 (xOffset', xSize') $ \(xOffset, xSize) -> do - let (topics, xs') = splitAt n xs - bytes = readMemory (num xOffset) (num xSize) vm - log = Log self bytes topics - - burn (g_log + g_logdata * (num xSize) + num n * g_logtopic) $ - accessMemoryRange fees xOffset xSize $ do - traceLog log - next - assign (state . stack) xs' - pushToSequence logs log - _ -> - underrun - - -- op: STOP - 0x00 -> doStop - - -- op: ADD - 0x01 -> stackOp2 (const g_verylow) (uncurry (+)) - -- op: MUL - 0x02 -> stackOp2 (const g_low) (uncurry (*)) - -- op: SUB - 0x03 -> stackOp2 (const g_verylow) (uncurry (-)) - - -- op: DIV - 0x04 -> stackOp2 (const g_low) (uncurry (sDiv)) - - -- op: SDIV - 0x05 -> - stackOp2 (const g_low) (uncurry sdiv) - - -- op: MOD - 0x06 -> stackOp2 (const g_low) $ \(S a x, S b y) -> S (ITE (IsZero b) (Literal 0) (Mod a b)) (ite (y .== 0) 0 (x `sMod` y)) - - -- op: SMOD - 0x07 -> stackOp2 (const g_low) $ uncurry smod - -- op: ADDMOD - 0x08 -> stackOp3 (const g_mid) (\(x, y, z) -> addmod x y z) - -- op: MULMOD - 0x09 -> stackOp3 (const g_mid) (\(x, y, z) -> mulmod x y z) - - -- op: LT - 0x10 -> stackOp2 (const g_verylow) $ \(S a x, S b y) -> iteWhiff (LT a b) (x .< y) 1 0 - -- op: GT - 0x11 -> stackOp2 (const g_verylow) $ \(S a x, S b y) -> iteWhiff (GT a b) (x .> y) 1 0 - -- op: SLT - 0x12 -> stackOp2 (const g_verylow) $ uncurry slt - -- op: SGT - 0x13 -> stackOp2 (const g_verylow) $ uncurry sgt - - -- op: EQ - 0x14 -> stackOp2 (const g_verylow) $ \(S a x, S b y) -> iteWhiff (Eq a b) (x .== y) 1 0 - -- op: ISZERO - 0x15 -> stackOp1 (const g_verylow) $ \(S a x) -> iteWhiff (IsZero a) (x .== 0) 1 0 - - -- op: AND - 0x16 -> stackOp2 (const g_verylow) $ uncurry (.&.) - -- op: OR - 0x17 -> stackOp2 (const g_verylow) $ uncurry (.|.) - -- op: XOR - 0x18 -> stackOp2 (const g_verylow) $ uncurry xor - -- op: NOT - 0x19 -> stackOp1 (const g_verylow) complement - - -- op: BYTE - 0x1a -> stackOp2 (const g_verylow) $ \case - (n, _) | (forceLit n) >= 32 -> 0 - (n, x) | otherwise -> 0xff .&. shiftR x (8 * (31 - num (forceLit n))) - - -- op: SHL - 0x1b -> stackOp2 (const g_verylow) $ \((S a n), (S b x)) -> S (SHL b a) $ sShiftLeft x n - -- op: SHR - 0x1c -> stackOp2 (const g_verylow) $ \((S a n), (S b x)) -> S (SHR b a) $ sShiftRight x n - -- op: SAR - 0x1d -> stackOp2 (const g_verylow) $ \((S a n), (S b x)) -> S (SAR b a) $ sSignedShiftArithRight x n - - -- op: SHA3 - -- more accurately refered to as KECCAK - 0x20 -> - case stk of - (xOffset' : xSize' : xs) -> - forceConcrete xOffset' $ - \xOffset -> forceConcrete xSize' $ \xSize -> - burn (g_sha3 + g_sha3word * ceilDiv (num xSize) 32) $ - accessMemoryRange fees xOffset xSize $ do - (hash@(S _ hash'), invMap, bytes) <- case readMemory xOffset xSize vm of - ConcreteBuffer bs -> do - pure (litWord $ keccakBlob bs, Map.singleton (keccakBlob bs) bs, litBytes bs) - SymbolicBuffer bs -> do - let hash' = symkeccak' bs - return (S (FromKeccak $ SymbolicBuffer bs) hash', mempty, bs) - - -- Although we would like to simply assert that the uninterpreted function symkeccak' - -- is injective, this proves to cause a lot of concern for our smt solvers, probably - -- due to the introduction of universal quantifiers into the queries. - - -- Instead, we keep track of all of the particular invocations of symkeccak' we see - -- (similarly to sha3Crack), and simply assert that injectivity holds for these - -- particular invocations. - -- - -- We additionally make the probabalisitc assumption that the output of symkeccak' - -- is greater than 100. This lets us avoid having to reason about storage collisions - -- between mappings and "normal" slots - - let previousUsed = view (env . keccakUsed) vm - env . keccakUsed <>= [(bytes, hash')] - constraints <>= (hash' .> 100, Todo "probabilistic keccak assumption" []): - (fmap (\(preimage, image) -> - -- keccak is a function - ((preimage .== bytes .=> image .== hash') .&& - -- which is injective - (image .== hash' .=> preimage .== bytes), Todo "injective keccak assumption" [])) - previousUsed) - - next - assign (state . stack) (hash : xs) - (env . sha3Crack) <>= invMap - _ -> underrun - - -- op: ADDRESS - 0x30 -> - limitStack 1 $ - burn g_base (next >> push (num self)) - - -- op: BALANCE - 0x31 -> - case stk of - (x':xs) -> forceConcrete x' $ \x -> - accessAndBurn (num x) $ - fetchAccount (num x) $ \c -> do - next - assign (state . stack) xs - push (view balance c) - [] -> - underrun - - -- op: ORIGIN - 0x32 -> - limitStack 1 . burn g_base $ - next >> push (num (the tx origin)) - - -- op: CALLER - 0x33 -> - limitStack 1 . burn g_base $ - let toSymWord :: SAddr -> SymWord - toSymWord (SAddr x) = case unliteral x of - Just s -> litWord $ num s - Nothing -> var "CALLER" $ sFromIntegral x - in next >> pushSym (toSymWord (the state caller)) - - -- op: CALLVALUE - 0x34 -> - limitStack 1 . burn g_base $ - next >> pushSym (the state callvalue) - - -- op: CALLDATALOAD - 0x35 -> stackOp1 (const g_verylow) $ - \ind -> uncurry (readSWordWithBound ind) (the state calldata) - - -- op: CALLDATASIZE - 0x36 -> - limitStack 1 . burn g_base $ - next >> pushSym (snd (the state calldata)) - - -- op: CALLDATACOPY - 0x37 -> - case stk of - (xTo' : xFrom' : xSize' : xs) -> forceConcrete3 (xTo',xFrom',xSize') $ \(xTo,xFrom,xSize) -> - burn (g_verylow + g_copy * ceilDiv (num xSize) 32) $ - accessUnboundedMemoryRange fees xTo xSize $ do - next - assign (state . stack) xs - case the state calldata of - (SymbolicBuffer cd, (S _ cdlen)) -> copyBytesToMemory (SymbolicBuffer [ite (i .<= cdlen) x 0 | (x, i) <- zip cd [1..]]) xSize xFrom xTo - -- when calldata is concrete, - -- the bound should always be equal to the bytestring length - (cd, _) -> copyBytesToMemory cd xSize xFrom xTo - _ -> underrun - - -- op: CODESIZE - 0x38 -> - limitStack 1 . burn g_base $ - next >> push (num (len (the state code))) - - -- op: CODECOPY - 0x39 -> - case stk of - (memOffset' : codeOffset' : n' : xs) -> forceConcrete3 (memOffset',codeOffset',n') $ \(memOffset,codeOffset,n) -> do - burn (g_verylow + g_copy * ceilDiv (num n) 32) $ - accessUnboundedMemoryRange fees memOffset n $ do - next - assign (state . stack) xs - copyBytesToMemory (the state code) - n codeOffset memOffset - _ -> underrun - - -- op: GASPRICE - 0x3a -> - limitStack 1 . burn g_base $ - next >> push (the tx gasprice) - - -- op: EXTCODESIZE - 0x3b -> - case stk of - (x':xs) -> makeUnique x' $ \x -> - if x == num cheatCode - then do - next - assign (state . stack) xs - push (w256 1) - else - accessAndBurn (num x) $ - fetchAccount (num x) $ \c -> do - next - assign (state . stack) xs - push (num (len (view bytecode c))) - [] -> - underrun - - -- op: EXTCODECOPY - 0x3c -> - case stk of - ( extAccount' - : memOffset' - : codeOffset' - : codeSize' - : xs ) -> - forceConcrete4 (extAccount', memOffset', codeOffset', codeSize') $ - \(extAccount, memOffset, codeOffset, codeSize) -> do - acc <- accessAccountForGas (num extAccount) - let cost = if acc then g_warm_storage_read else g_cold_account_access - burn (cost + g_copy * ceilDiv (num codeSize) 32) $ - accessUnboundedMemoryRange fees memOffset codeSize $ - fetchAccount (num extAccount) $ \c -> do - next - assign (state . stack) xs - copyBytesToMemory (view bytecode c) - codeSize codeOffset memOffset - _ -> underrun - - -- op: RETURNDATASIZE - 0x3d -> - limitStack 1 . burn g_base $ - next >> push (num $ len (the state returndata)) - - -- op: RETURNDATACOPY - 0x3e -> - case stk of - (xTo' : xFrom' : xSize' :xs) -> forceConcrete3 (xTo', xFrom', xSize') $ - \(xTo, xFrom, xSize) -> - burn (g_verylow + g_copy * ceilDiv (num xSize) 32) $ - accessUnboundedMemoryRange fees xTo xSize $ do - next - assign (state . stack) xs - if num (len (the state returndata)) < xFrom + xSize || xFrom + xSize < xFrom - then vmError InvalidMemoryAccess - else copyBytesToMemory (the state returndata) xSize xFrom xTo - _ -> underrun - - -- op: EXTCODEHASH - 0x3f -> - case stk of - (x':xs) -> forceConcrete x' $ \x -> - accessAndBurn (num x) $ do - next - assign (state . stack) xs - fetchAccount (num x) $ \c -> - if accountEmpty c - then push (num (0 :: Int)) - else case view bytecode c of - ConcreteBuffer b -> push (num (keccak b)) - b'@(SymbolicBuffer b) -> pushSym (S (FromKeccak b') $ symkeccak' b) - [] -> - underrun - - -- op: BLOCKHASH - 0x40 -> do - -- We adopt the fake block hash scheme of the VMTests, - -- so that blockhash(i) is the hash of i as decimal ASCII. - stackOp1 (const g_blockhash) $ - \(forceLit -> i) -> - if i + 256 < the block number || i >= the block number - then 0 - else - (num i :: Integer) - & show & Char8.pack & keccak & num - - -- op: COINBASE - 0x41 -> - limitStack 1 . burn g_base $ - next >> push (num (the block coinbase)) - - -- op: TIMESTAMP - 0x42 -> - limitStack 1 . burn g_base $ - next >> pushSym (the block timestamp) - - -- op: NUMBER - 0x43 -> - limitStack 1 . burn g_base $ - next >> push (the block number) - - -- op: DIFFICULTY - 0x44 -> - limitStack 1 . burn g_base $ - next >> push (the block difficulty) - - -- op: GASLIMIT - 0x45 -> - limitStack 1 . burn g_base $ - next >> push (the block gaslimit) - - -- op: CHAINID - 0x46 -> - limitStack 1 . burn g_base $ - next >> push (the env chainId) - - -- op: SELFBALANCE - 0x47 -> - limitStack 1 . burn g_low $ - next >> push (view balance this) - - -- op: BASEFEE - 0x48 -> - limitStack 1 . burn g_base $ - next >> push (the block baseFee) - - -- op: POP - 0x50 -> - case stk of - (_:xs) -> burn g_base (next >> assign (state . stack) xs) - _ -> underrun - - -- op: MLOAD - 0x51 -> - case stk of - (x':xs) -> forceConcrete x' $ \x -> - burn g_verylow $ - accessMemoryWord fees x $ do - next - assign (state . stack) (view (word256At (num x)) mem : xs) - _ -> underrun - - -- op: MSTORE - 0x52 -> - case stk of - (x':y:xs) -> forceConcrete x' $ \x -> - burn g_verylow $ - accessMemoryWord fees x $ do - next - assign (state . memory . word256At (num x)) y - assign (state . stack) xs - _ -> underrun - - -- op: MSTORE8 - 0x53 -> - case stk of - (x':(S _ y):xs) -> forceConcrete x' $ \x -> - burn g_verylow $ - accessMemoryRange fees x 1 $ do - let yByte = bvExtract (Proxy :: Proxy 7) (Proxy :: Proxy 0) y - next - modifying (state . memory) (setMemoryByte x yByte) - assign (state . stack) xs - _ -> underrun - - -- op: SLOAD - 0x54 -> - case stk of - (x:xs) -> do - acc <- accessStorageForGas self x - let cost = if acc then g_warm_storage_read else g_cold_sload - burn cost $ - accessStorage self x $ \y -> do - next - assign (state . stack) (y:xs) - _ -> underrun - - -- op: SSTORE - 0x55 -> - notStatic $ - case stk of - (x:new:xs) -> - accessStorage self x $ \current -> do - availableGas <- use (state . gas) - - if num availableGas <= g_callstipend - then finishFrame (FrameErrored (OutOfGas availableGas (num g_callstipend))) - else do - let original = case view storage this of - Concrete _ -> fromMaybe 0 (Map.lookup (forceLit x) (view origStorage this)) - Symbolic _ _ -> 0 -- we don't use this value anywhere anyway - storage_cost = case (maybeLitWord current, maybeLitWord new) of - (Just current', Just new') -> - if (current' == new') then g_sload - else if (current' == original) && (original == 0) then g_sset - else if (current' == original) then g_sreset - else g_sload - - -- if any of the arguments are symbolic, - -- assume worst case scenario - _ -> g_sset - - acc <- accessStorageForGas self x - let cold_storage_cost = if acc then 0 else g_cold_sload - burn (storage_cost + cold_storage_cost) $ do - next - assign (state . stack) xs - modifying (env . contracts . ix self . storage) - (writeStorage x new) - - case (maybeLitWord current, maybeLitWord new) of - (Just current', Just new') -> - unless (current' == new') $ - if current' == original - then when (original /= 0 && new' == 0) $ - refund (g_sreset + g_access_list_storage_key) - else do - when (original /= 0) $ - if new' == 0 - then refund (g_sreset + g_access_list_storage_key) - else unRefund (g_sreset + g_access_list_storage_key) - when (original == new') $ - if original == 0 - then refund (g_sset - g_sload) - else refund (g_sreset - g_sload) - -- if any of the arguments are symbolic, - -- don't change the refund counter - _ -> noop - _ -> underrun - - -- op: JUMP - 0x56 -> - case stk of - (x:xs) -> - burn g_mid $ forceConcrete x $ \x' -> - checkJump x' xs - _ -> underrun - - -- op: JUMPI - 0x57 -> do - case stk of - (x:y@(S w _):xs) -> forceConcrete x $ \x' -> - burn g_high $ - let jump :: Bool -> EVM () - jump True = assign (state . stack) xs >> next - jump _ = checkJump x' xs - in case maybeLitWord y of - Just y' -> jump (0 == y') - -- if the jump condition is symbolic, an smt query has to be made. - Nothing -> askSMT (self, the state pc) (0 .== y, IsZero w) jump - _ -> underrun - - -- op: PC - 0x58 -> - limitStack 1 . burn g_base $ - next >> push (num (the state pc)) - - -- op: MSIZE - 0x59 -> - limitStack 1 . burn g_base $ - next >> push (num (the state memorySize)) - - -- op: GAS - 0x5a -> - limitStack 1 . burn g_base $ - next >> push (the state gas - num g_base) - - -- op: JUMPDEST - 0x5b -> burn g_jumpdest next - - -- op: EXP - 0x0a -> - let cost (_ ,(forceLit -> exponent)) = - if exponent == 0 - then g_exp - else g_exp + g_expbyte * num (ceilDiv (1 + log2 exponent) 8) - in stackOp2 cost $ \((S a x),(S b y)) -> S (Exp a b) (x .^ y) - - -- op: SIGNEXTEND - 0x0b -> - stackOp2 (const g_low) $ \((forceLit -> bytes), w@(S a x)) -> - if bytes >= 32 then w - else let n = num bytes * 8 + 7 in - S (Todo "signextend" [a]) $ ite (sTestBit x n) - (x .|. complement (bit n - 1)) - (x .&. (bit n - 1)) - - -- op: CREATE - 0xf0 -> - notStatic $ - case stk of - (xValue' : xOffset' : xSize' : xs) -> forceConcrete3 (xValue', xOffset', xSize') $ - \(xValue, xOffset, xSize) -> do - accessMemoryRange fees xOffset xSize $ do - availableGas <- use (state . gas) - let - newAddr = createAddress self (wordValue (view nonce this)) - (cost, gas') = costOfCreate fees availableGas 0 - _ <- accessAccountForGas newAddr - burn (cost - gas') $ - let initCode = readMemory (num xOffset) (num xSize) vm - in create self this (num gas') xValue xs newAddr initCode - _ -> underrun - - -- op: CALL - 0xf1 -> - case stk of - ( xGas' - : S _ xTo - : (forceLit -> xValue) - : xInOffset' - : xInSize' - : xOutOffset' - : xOutSize' - : xs - ) -> forceConcrete5 (xGas',xInOffset', xInSize', xOutOffset', xOutSize') $ - \(xGas, xInOffset, xInSize, xOutOffset, xOutSize) -> - (if xValue > 0 then notStatic else id) $ - let target = SAddr $ sFromIntegral xTo in - delegateCall this xGas target target xValue xInOffset xInSize xOutOffset xOutSize xs $ \callee -> do - zoom state $ do - assign callvalue (litWord xValue) - assign caller (litAddr self) - assign contract callee - transfer self callee xValue - touchAccount self - touchAccount callee - _ -> - underrun - - -- op: CALLCODE - 0xf2 -> - case stk of - ( xGas' - : S _ xTo' - : (forceLit -> xValue) - : xInOffset' - : xInSize' - : xOutOffset' - : xOutSize' - : xs - ) -> forceConcrete5 (xGas', xInOffset', xInSize', xOutOffset', xOutSize') $ - \(xGas, xInOffset, xInSize, xOutOffset, xOutSize) -> - let target = SAddr $ sFromIntegral xTo' in - delegateCall this xGas target (litAddr self) xValue xInOffset xInSize xOutOffset xOutSize xs $ \_ -> do - zoom state $ do - assign callvalue (litWord xValue) - assign caller (litAddr self) - touchAccount self - _ -> - underrun - - -- op: RETURN - 0xf3 -> - case stk of - (xOffset' : xSize' :_) -> forceConcrete2 (xOffset', xSize') $ \(xOffset, xSize) -> - accessMemoryRange fees xOffset xSize $ do - let - output = readMemory xOffset xSize vm - codesize = num (len output) - maxsize = the block maxCodeSize - creation = case view frames vm of - [] -> the tx isCreate - frame:_ -> case view frameContext frame of - CreationContext {} -> True - CallContext {} -> False - if creation - then - if codesize > maxsize - then - finishFrame (FrameErrored (MaxCodeSizeExceeded maxsize codesize)) - else - if isConcretely (readByteOrZero 0 output) ((==) 0xef) - then finishFrame $ FrameErrored InvalidFormat - else do - burn (g_codedeposit * num codesize) $ - finishFrame (FrameReturned output) - else - finishFrame (FrameReturned output) - _ -> underrun - - -- op: DELEGATECALL - 0xf4 -> - case stk of - (xGas' - :S _ xTo - :xInOffset' - :xInSize' - :xOutOffset' - :xOutSize' - :xs) -> forceConcrete5 (xGas', xInOffset', xInSize', xOutOffset', xOutSize') $ - \(xGas, xInOffset, xInSize, xOutOffset, xOutSize) -> - let target = SAddr $ sFromIntegral xTo in - delegateCall this xGas target (litAddr self) 0 xInOffset xInSize xOutOffset xOutSize xs $ \_ -> do - touchAccount self - _ -> underrun - - -- op: CREATE2 - 0xf5 -> notStatic $ - case stk of - (xValue' - :xOffset' - :xSize' - :xSalt' - :xs) -> forceConcrete4 (xValue', xOffset', xSize', xSalt') $ - \(xValue, xOffset, xSize, xSalt) -> - accessMemoryRange fees xOffset xSize $ do - availableGas <- use (state . gas) - - forceConcreteBuffer (readMemory (num xOffset) (num xSize) vm) $ \initCode -> do - let - newAddr = create2Address self (num xSalt) initCode - (cost, gas') = costOfCreate fees availableGas xSize - _ <- accessAccountForGas newAddr - burn (cost - gas') $ - create self this (num gas') xValue xs newAddr (ConcreteBuffer initCode) - _ -> underrun - - -- op: STATICCALL - 0xfa -> - case stk of - (xGas' - :S _ xTo - :xInOffset' - :xInSize' - :xOutOffset' - :xOutSize' - :xs) -> forceConcrete5 (xGas', xInOffset', xInSize', xOutOffset', xOutSize') $ - \(xGas, xInOffset, xInSize, xOutOffset, xOutSize) -> do - let target = SAddr $ sFromIntegral xTo - delegateCall this xGas target target 0 xInOffset xInSize xOutOffset xOutSize xs $ \callee -> do - zoom state $ do - assign callvalue 0 - assign caller (litAddr self) - assign contract callee - assign static True - touchAccount self - touchAccount callee - _ -> - underrun - - -- op: SELFDESTRUCT - 0xff -> - notStatic $ - case stk of - [] -> underrun - (xTo':_) -> forceConcrete xTo' $ \(num -> xTo) -> do - acc <- accessAccountForGas (num xTo) - let cost = if acc then 0 else g_cold_account_access - funds = view balance this - recipientExists = accountExists xTo vm - c_new = if not recipientExists && funds /= 0 - then num g_selfdestruct_newaccount - else 0 - burn (g_selfdestruct + c_new + cost) $ do - selfdestruct self - touchAccount xTo - - if funds /= 0 - then fetchAccount xTo $ \_ -> do - env . contracts . ix xTo . balance += funds - assign (env . contracts . ix self . balance) 0 - doStop - else doStop - - -- op: REVERT - 0xfd -> - case stk of - (xOffset':xSize':_) -> forceConcrete2 (xOffset', xSize') $ \(xOffset, xSize) -> - accessMemoryRange fees xOffset xSize $ do - let output = readMemory xOffset xSize vm - finishFrame (FrameReverted output) - _ -> underrun - - xxx -> - vmError (UnrecognizedOpcode xxx) - -transfer :: Addr -> Addr -> Word -> EVM () -transfer xFrom xTo xValue = - zoom (env . contracts) $ do - ix xFrom . balance -= xValue - ix xTo . balance += xValue - --- | Checks a *CALL for failure; OOG, too many callframes, memory access etc. -callChecks - :: (?op :: Word8) - => Contract -> Word -> Addr -> Addr -> Word -> Word -> Word -> Word -> Word -> [SymWord] - -- continuation with gas available for call - -> (Integer -> EVM ()) - -> EVM () -callChecks this xGas xContext xTo xValue xInOffset xInSize xOutOffset xOutSize xs continue = do - vm <- get - let fees = view (block . schedule) vm - accessMemoryRange fees xInOffset xInSize $ - accessMemoryRange fees xOutOffset xOutSize $ do - availableGas <- use (state . gas) - let recipientExists = accountExists xContext vm - (cost, gas') <- costOfCall fees recipientExists xValue availableGas xGas xTo - burn (cost - gas') $ do - if xValue > view balance this - then do - assign (state . stack) (0 : xs) - assign (state . returndata) mempty - pushTrace $ ErrorTrace $ BalanceTooLow xValue (view balance this) - next - else if length (view frames vm) >= 1024 - then do - assign (state . stack) (0 : xs) - assign (state . returndata) mempty - pushTrace $ ErrorTrace CallDepthLimitReached - next - else continue gas' - -precompiledContract - :: (?op :: Word8) - => Contract - -> Word - -> Addr - -> Addr - -> Word - -> Word -> Word -> Word -> Word - -> [SymWord] - -> EVM () -precompiledContract this xGas precompileAddr recipient xValue inOffset inSize outOffset outSize xs = - callChecks this xGas recipient precompileAddr xValue inOffset inSize outOffset outSize xs $ \gas' -> - do - executePrecompile precompileAddr gas' inOffset inSize outOffset outSize xs - self <- use (state . contract) - stk <- use (state . stack) - case stk of - (x:_) -> case maybeLitWord x of - Just 0 -> - return () - Just 1 -> - fetchAccount recipient $ \_ -> do - - transfer self recipient xValue - touchAccount self - touchAccount recipient - _ -> vmError UnexpectedSymbolicArg - _ -> underrun - -executePrecompile - :: (?op :: Word8) - => Addr - -> Integer -> Word -> Word -> Word -> Word -> [SymWord] - -> EVM () -executePrecompile preCompileAddr gasCap inOffset inSize outOffset outSize xs = do - vm <- get - let input = readMemory (num inOffset) (num inSize) vm - fees = view (block . schedule) vm - cost = costOfPrecompile fees preCompileAddr input - notImplemented = error $ "precompile at address " <> show preCompileAddr <> " not yet implemented" - precompileFail = burn (num gasCap - cost) $ do - assign (state . stack) (0 : xs) - pushTrace $ ErrorTrace PrecompileFailure - next - if cost > num gasCap then - burn (num gasCap) $ do - assign (state . stack) (0 : xs) - next - else - burn cost $ - case preCompileAddr of - -- ECRECOVER - 0x1 -> - -- TODO: support symbolic variant - forceConcreteBuffer input $ \input' -> - case EVM.Precompiled.execute 0x1 (truncpadlit 128 input') 32 of - Nothing -> do - -- return no output for invalid signature - assign (state . stack) (1 : xs) - assign (state . returndata) mempty - next - Just output -> do - assign (state . stack) (1 : xs) - assign (state . returndata) (ConcreteBuffer output) - copyBytesToMemory (ConcreteBuffer output) outSize 0 outOffset - next - - -- SHA2-256 - 0x2 -> - let - hash = case input of - ConcreteBuffer input' -> ConcreteBuffer $ BS.pack $ BA.unpack (Crypto.hash input' :: Digest SHA256) - SymbolicBuffer input' -> SymbolicBuffer $ symSHA256 input' - in do - assign (state . stack) (1 : xs) - assign (state . returndata) hash - copyBytesToMemory hash outSize 0 outOffset - next - - -- RIPEMD-160 - 0x3 -> - -- TODO: support symbolic variant - forceConcreteBuffer input $ \input' -> - - let - padding = BS.pack $ replicate 12 0 - hash' = BS.pack $ BA.unpack (Crypto.hash input' :: Digest RIPEMD160) - hash = ConcreteBuffer $ padding <> hash' - in do - assign (state . stack) (1 : xs) - assign (state . returndata) hash - copyBytesToMemory hash outSize 0 outOffset - next - - -- IDENTITY - 0x4 -> do - assign (state . stack) (1 : xs) - assign (state . returndata) input - copyCallBytesToMemory input outSize 0 outOffset - next - - -- MODEXP - 0x5 -> - -- TODO: support symbolic variant - forceConcreteBuffer input $ \input' -> - - let - (lenb, lene, lenm) = parseModexpLength input' - - output = ConcreteBuffer $ - if isZero (96 + lenb + lene) lenm input' - then truncpadlit (num lenm) (asBE (0 :: Int)) - else - let - b = asInteger $ lazySlice 96 lenb input' - e = asInteger $ lazySlice (96 + lenb) lene input' - m = asInteger $ lazySlice (96 + lenb + lene) lenm input' - in - padLeft (num lenm) (asBE (expFast b e m)) - in do - assign (state . stack) (1 : xs) - assign (state . returndata) output - copyBytesToMemory output outSize 0 outOffset - next - - -- ECADD - 0x6 -> - -- TODO: support symbolic variant - forceConcreteBuffer input $ \input' -> - case EVM.Precompiled.execute 0x6 (truncpadlit 128 input') 64 of - Nothing -> precompileFail - Just output -> do - let truncpaddedOutput = ConcreteBuffer $ truncpadlit 64 output - assign (state . stack) (1 : xs) - assign (state . returndata) truncpaddedOutput - copyBytesToMemory truncpaddedOutput outSize 0 outOffset - next - - -- ECMUL - 0x7 -> - -- TODO: support symbolic variant - forceConcreteBuffer input $ \input' -> - - case EVM.Precompiled.execute 0x7 (truncpadlit 96 input') 64 of - Nothing -> precompileFail - Just output -> do - let truncpaddedOutput = ConcreteBuffer $ truncpadlit 64 output - assign (state . stack) (1 : xs) - assign (state . returndata) truncpaddedOutput - copyBytesToMemory truncpaddedOutput outSize 0 outOffset - next - - -- ECPAIRING - 0x8 -> - -- TODO: support symbolic variant - forceConcreteBuffer input $ \input' -> - - case EVM.Precompiled.execute 0x8 input' 32 of - Nothing -> precompileFail - Just output -> do - let truncpaddedOutput = ConcreteBuffer $ truncpadlit 32 output - assign (state . stack) (1 : xs) - assign (state . returndata) truncpaddedOutput - copyBytesToMemory truncpaddedOutput outSize 0 outOffset - next - - -- BLAKE2 - 0x9 -> - -- TODO: support symbolic variant - forceConcreteBuffer input $ \input' -> do - - case (BS.length input', 1 >= BS.last input') of - (213, True) -> case EVM.Precompiled.execute 0x9 input' 64 of - Just output -> do - let truncpaddedOutput = ConcreteBuffer $ truncpadlit 64 output - assign (state . stack) (1 : xs) - assign (state . returndata) truncpaddedOutput - copyBytesToMemory truncpaddedOutput outSize 0 outOffset - next - Nothing -> precompileFail - _ -> precompileFail - - - _ -> notImplemented - -truncpadlit :: Int -> ByteString -> ByteString -truncpadlit n xs = if m > n then BS.take n xs - else BS.append xs (BS.replicate (n - m) 0) - where m = BS.length xs - -lazySlice :: Word -> Word -> ByteString -> LS.ByteString -lazySlice offset size bs = - let bs' = LS.take (num size) (LS.drop (num offset) (fromStrict bs)) - in bs' <> LS.replicate ((num size) - LS.length bs') 0 - -parseModexpLength :: ByteString -> (Word, Word, Word) -parseModexpLength input = - let lenb = w256 $ word $ LS.toStrict $ lazySlice 0 32 input - lene = w256 $ word $ LS.toStrict $ lazySlice 32 64 input - lenm = w256 $ word $ LS.toStrict $ lazySlice 64 96 input - in (lenb, lene, lenm) - ---- checks if a range of ByteString bs starting at offset and length size is all zeros. -isZero :: Word -> Word -> ByteString -> Bool -isZero offset size bs = - LS.all (== 0) $ - LS.take (num size) $ - LS.drop (num offset) $ - fromStrict bs - -asInteger :: LS.ByteString -> Integer -asInteger xs = if xs == mempty then 0 - else 256 * asInteger (LS.init xs) - + num (LS.last xs) - --- * Opcode helper actions - -noop :: Monad m => m () -noop = pure () - -pushTo :: MonadState s m => ASetter s s [a] [a] -> a -> m () -pushTo f x = f %= (x :) - -pushToSequence :: MonadState s m => ASetter s s (Seq a) (Seq a) -> a -> m () -pushToSequence f x = f %= (Seq.|> x) - -getCodeLocation :: VM -> CodeLocation -getCodeLocation vm = (view (state . contract) vm, view (state . pc) vm) - --- | Ask the SMT solver to provide a concrete model for val iff a unique model exists -makeUnique :: SymWord -> (Word -> EVM ()) -> EVM () -makeUnique sw@(S w val) cont = case maybeLitWord sw of - Nothing -> do - conditions <- use constraints - assign result . Just . VMFailure . Query $ PleaseMakeUnique val (fst <$> conditions) $ \case - Unique a -> do - assign result Nothing - cont (C w $ fromSizzle a) - InconsistentU -> vmError DeadPath - TimeoutU -> vmError SMTTimeout - Multiple -> vmError $ NotUnique w - Just a -> cont a - --- | Construct SMT Query and halt execution until resolved -askSMT :: CodeLocation -> (SBool, Whiff) -> (Bool -> EVM ()) -> EVM () -askSMT codeloc (condition, whiff) continue = do - -- We keep track of how many times we have come across this particular - -- (contract, pc) combination in the `iteration` mapping. - iteration <- use (iterations . at codeloc . non 0) - - -- If we are backstepping, the result of this query should be cached - -- already. So we first check the cache to see if the result is known - use (cache . path . at (codeloc, iteration)) >>= \case - -- If the query has been done already, select path or select the only available - Just w -> choosePath (Case w) - -- If this is a new query, run the query, cache the result - -- increment the iterations and select appropriate path - Nothing -> do pathconds <- use constraints - assign result . Just . VMFailure . Query $ PleaseAskSMT - condition' (fst <$> pathconds) choosePath - - where condition' = simplifyCondition condition whiff - - choosePath :: BranchCondition -> EVM () - -- Only one path is possible - choosePath (Case v) = do assign result Nothing - pushTo constraints $ if v then (condition', whiff) else (sNot condition', IsZero whiff) - iteration <- use (iterations . at codeloc . non 0) - assign (cache . path . at (codeloc, iteration)) (Just v) - assign (iterations . at codeloc) (Just (iteration + 1)) - continue v - -- Both paths are possible; we ask for more input - choosePath Unknown = assign result . Just . VMFailure . Choose . PleaseChoosePath whiff $ choosePath . Case - -- None of the paths are possible; fail this branch - choosePath Inconsistent = vmError DeadPath - --- | Construct RPC Query and halt execution until resolved -fetchAccount :: Addr -> (Contract -> EVM ()) -> EVM () -fetchAccount addr continue = - use (env . contracts . at addr) >>= \case - Just c -> continue c - Nothing -> - use (cache . fetched . at addr) >>= \case - Just c -> do - assign (env . contracts . at addr) (Just c) - continue c - Nothing -> do - model <- use (env . storageModel) - assign result . Just . VMFailure $ Query $ - PleaseFetchContract addr model - (\c -> do assign (cache . fetched . at addr) (Just c) - assign (env . contracts . at addr) (Just c) - assign result Nothing - continue c) - -readStorage :: Storage -> SymWord -> Maybe (SymWord) -readStorage (Symbolic _ s) (S w loc) = Just $ S (FromStorage w s) $ readArray s loc -readStorage (Concrete s) loc = Map.lookup (forceLit loc) s - -writeStorage :: SymWord -> SymWord -> Storage -> Storage -writeStorage k@(S _ loc) v@(S _ val) (Symbolic xs s) = Symbolic ((k,v):xs) (writeArray s loc val) -writeStorage loc val (Concrete s) = Concrete (Map.insert (forceLit loc) val s) - -accessStorage - :: Addr -- ^ Contract address - -> SymWord -- ^ Storage slot key - -> (SymWord -> EVM ()) -- ^ Continuation - -> EVM () -accessStorage addr slot continue = - use (env . contracts . at addr) >>= \case - Just c -> - case readStorage (view storage c) slot of - -- Notice that if storage is symbolic, we always continue straight away - Just x -> - continue x - Nothing -> - if view external c - then - -- check if the slot is cached - use (cache . fetched . at addr) >>= \case - Nothing -> mkQuery - Just cachedContract -> - maybe mkQuery continue (readStorage (view storage cachedContract) slot) - else do - modifying (env . contracts . ix addr . storage) (writeStorage slot 0) - continue 0 - Nothing -> - fetchAccount addr $ \_ -> - accessStorage addr slot continue - where - mkQuery = assign result . Just . VMFailure . Query $ - PleaseFetchSlot addr (forceLit slot) - (\(litWord -> x) -> do - modifying (cache . fetched . ix addr . storage) (writeStorage slot x) - modifying (env . contracts . ix addr . storage) (writeStorage slot x) - assign result Nothing - continue x) - -accountExists :: Addr -> VM -> Bool -accountExists addr vm = - case view (env . contracts . at addr) vm of - Just c -> not (accountEmpty c) - Nothing -> False - --- EIP 161 -accountEmpty :: Contract -> Bool -accountEmpty c = - case view contractcode c of - RuntimeCode b -> len b == 0 - _ -> False - && (view nonce c == 0) - && (view balance c == 0) - --- * How to finalize a transaction -finalize :: EVM () -finalize = do - let - revertContracts = use (tx . txReversion) >>= assign (env . contracts) - revertSubstate = assign (tx . substate) (SubState mempty mempty mempty mempty mempty) - - use result >>= \case - Nothing -> - error "Finalising an unfinished tx." - Just (VMFailure (Revert _)) -> do - revertContracts - revertSubstate - Just (VMFailure _) -> do - -- burn remaining gas - assign (state . gas) 0 - revertContracts - revertSubstate - Just (VMSuccess output) -> do - -- deposit the code from a creation tx - creation <- use (tx . isCreate) - createe <- use (state . contract) - createeExists <- (Map.member createe) <$> use (env . contracts) - - when (creation && createeExists) $ replaceCode createe (RuntimeCode output) - - -- compute and pay the refund to the caller and the - -- corresponding payment to the miner - txOrigin <- use (tx . origin) - sumRefunds <- (sum . (snd <$>)) <$> (use (tx . substate . refunds)) - miner <- use (block . coinbase) - blockReward <- num . r_block <$> (use (block . schedule)) - gasPrice <- use (tx . gasprice) - priorityFee <- use (tx . txPriorityFee) - gasLimit <- use (tx . txgaslimit) - gasRemaining <- use (state . gas) - - let - gasUsed = gasLimit - gasRemaining - cappedRefund = min (quot gasUsed 5) (num sumRefunds) - originPay = (gasRemaining + cappedRefund) * gasPrice - - minerPay = priorityFee * gasUsed - - modifying (env . contracts) - (Map.adjust (over balance (+ originPay)) txOrigin) - modifying (env . contracts) - (Map.adjust (over balance (+ minerPay)) miner) - touchAccount miner - - -- pay out the block reward, recreating the miner if necessary - preuse (env . contracts . ix miner) >>= \case - Nothing -> modifying (env . contracts) - (Map.insert miner (initialContract (EVM.RuntimeCode mempty))) - Just _ -> noop - modifying (env . contracts) - (Map.adjust (over balance (+ blockReward)) miner) - - -- perform state trie clearing (EIP 161), of selfdestructs - -- and touched accounts. addresses are cleared if they have - -- a) selfdestructed, or - -- b) been touched and - -- c) are empty. - -- (see Yellow Paper "Accrued Substate") - -- - -- remove any destructed addresses - destroyedAddresses <- use (tx . substate . selfdestructs) - modifying (env . contracts) - (Map.filterWithKey (\k _ -> (notElem k destroyedAddresses))) - -- then, clear any remaining empty and touched addresses - touchedAddresses <- use (tx . substate . touchedAccounts) - modifying (env . contracts) - (Map.filterWithKey - (\k a -> not ((elem k touchedAddresses) && accountEmpty a))) - --- | Loads the selected contract as the current contract to execute -loadContract :: Addr -> EVM () -loadContract target = - preuse (env . contracts . ix target . contractcode) >>= - \case - Nothing -> - error "Call target doesn't exist" - Just (InitCode targetCode) -> do - assign (state . contract) target - assign (state . code) targetCode - assign (state . codeContract) target - Just (RuntimeCode targetCode) -> do - assign (state . contract) target - assign (state . code) targetCode - assign (state . codeContract) target - -limitStack :: Int -> EVM () -> EVM () -limitStack n continue = do - stk <- use (state . stack) - if length stk + n > 1024 - then vmError StackLimitExceeded - else continue - -notStatic :: EVM () -> EVM () -notStatic continue = do - bad <- use (state . static) - if bad - then vmError StateChangeWhileStatic - else continue - --- | Burn gas, failing if insufficient gas is available --- We use the `Integer` type to avoid overflows in intermediate --- calculations and throw if the value won't fit into a uint64 -burn :: Integer -> EVM () -> EVM () -burn n' continue = - if n' > (2 :: Integer) ^ (64 :: Integer) - 1 - then vmError IllegalOverflow - else do - let n = num n' - available <- use (state . gas) - if n <= available - then do - state . gas -= n - burned += n - continue - else - vmError (OutOfGas available n) - -forceConcreteAddr :: SAddr -> (Addr -> EVM ()) -> EVM () -forceConcreteAddr n continue = case maybeLitAddr n of - Nothing -> vmError UnexpectedSymbolicArg - Just c -> continue c - -forceConcrete :: SymWord -> (Word -> EVM ()) -> EVM () -forceConcrete n continue = case maybeLitWord n of - Nothing -> vmError UnexpectedSymbolicArg - Just c -> continue c - -forceConcrete2 :: (SymWord, SymWord) -> ((Word, Word) -> EVM ()) -> EVM () -forceConcrete2 (n,m) continue = case (maybeLitWord n, maybeLitWord m) of - (Just c, Just d) -> continue (c, d) - _ -> vmError UnexpectedSymbolicArg - -forceConcrete3 :: (SymWord, SymWord, SymWord) -> ((Word, Word, Word) -> EVM ()) -> EVM () -forceConcrete3 (k,n,m) continue = case (maybeLitWord k, maybeLitWord n, maybeLitWord m) of - (Just c, Just d, Just f) -> continue (c, d, f) - _ -> vmError UnexpectedSymbolicArg - -forceConcrete4 :: (SymWord, SymWord, SymWord, SymWord) -> ((Word, Word, Word, Word) -> EVM ()) -> EVM () -forceConcrete4 (k,l,n,m) continue = case (maybeLitWord k, maybeLitWord l, maybeLitWord n, maybeLitWord m) of - (Just b, Just c, Just d, Just f) -> continue (b, c, d, f) - _ -> vmError UnexpectedSymbolicArg - -forceConcrete5 :: (SymWord, SymWord, SymWord, SymWord, SymWord) -> ((Word, Word, Word, Word, Word) -> EVM ()) -> EVM () -forceConcrete5 (k,l,m,n,o) continue = case (maybeLitWord k, maybeLitWord l, maybeLitWord m, maybeLitWord n, maybeLitWord o) of - (Just a, Just b, Just c, Just d, Just e) -> continue (a, b, c, d, e) - _ -> vmError UnexpectedSymbolicArg - -forceConcrete6 :: (SymWord, SymWord, SymWord, SymWord, SymWord, SymWord) -> ((Word, Word, Word, Word, Word, Word) -> EVM ()) -> EVM () -forceConcrete6 (k,l,m,n,o,p) continue = case (maybeLitWord k, maybeLitWord l, maybeLitWord m, maybeLitWord n, maybeLitWord o, maybeLitWord p) of - (Just a, Just b, Just c, Just d, Just e, Just f) -> continue (a, b, c, d, e, f) - _ -> vmError UnexpectedSymbolicArg - -forceConcreteBuffer :: Buffer -> (ByteString -> EVM ()) -> EVM () -forceConcreteBuffer (SymbolicBuffer b) continue = case maybeLitBytes b of - Nothing -> vmError UnexpectedSymbolicArg - Just bs -> continue bs -forceConcreteBuffer (ConcreteBuffer b) continue = continue b - --- * Substate manipulation -refund :: Integer -> EVM () -refund n = do - self <- use (state . contract) - pushTo (tx . substate . refunds) (self, n) - -unRefund :: Integer -> EVM () -unRefund n = do - self <- use (state . contract) - refs <- use (tx . substate . refunds) - assign (tx . substate . refunds) - (filter (\(a,b) -> not (a == self && b == n)) refs) - -touchAccount :: Addr -> EVM() -touchAccount = pushTo ((tx . substate) . touchedAccounts) - -selfdestruct :: Addr -> EVM() -selfdestruct = pushTo ((tx . substate) . selfdestructs) - -accessAndBurn :: Addr -> EVM () -> EVM () -accessAndBurn x cont = do - FeeSchedule {..} <- use ( block . schedule ) - acc <- accessAccountForGas x - let cost = if acc then g_warm_storage_read else g_cold_account_access - burn cost cont - --- | returns a wrapped boolean- if true, this address has been touched before in the txn (warm gas cost as in EIP 2929) --- otherwise cold -accessAccountForGas :: Addr -> EVM Bool -accessAccountForGas addr = do - accessedAddrs <- use (tx . substate . accessedAddresses) - let accessed = member addr accessedAddrs - assign (tx . substate . accessedAddresses) (insert addr accessedAddrs) - return accessed - --- | returns a wrapped boolean- if true, this slot has been touched before in the txn (warm gas cost as in EIP 2929) --- otherwise cold -accessStorageForGas :: Addr -> SymWord -> EVM Bool -accessStorageForGas addr key = do - accessedStrkeys <- use (tx . substate . accessedStorageKeys) - case maybeLitWord key of - Just litword -> do - let litword256 = wordValue litword - let accessed = member (addr, litword256) accessedStrkeys - assign (tx . substate . accessedStorageKeys) (insert (addr, litword256) accessedStrkeys) - return accessed - _ -> return False - --- * Cheat codes - --- The cheat code is 7109709ecfa91a80626ff3989d68f67f5b1dd12d. --- Call this address using one of the cheatActions below to do --- special things, e.g. changing the block timestamp. Beware that --- these are necessarily hevm specific. -cheatCode :: Addr -cheatCode = num (keccak "hevm cheat code") - -cheat - :: (?op :: Word8) - => (Word, Word) -> (Word, Word) - -> EVM () -cheat (inOffset, inSize) (outOffset, outSize) = do - mem <- use (state . memory) - vm <- get - let - abi = readMemoryWord32 inOffset mem - input = readMemory (inOffset + 4) (inSize - 4) vm - case fromSized <$> unliteral abi of - Nothing -> vmError UnexpectedSymbolicArg - Just abi' -> - case Map.lookup abi' cheatActions of - Nothing -> - vmError (BadCheatCode (Just abi')) - Just action -> do - action outOffset outSize input - next - push 1 - -type CheatAction = Word -> Word -> Buffer -> EVM () - -cheatActions :: Map Word32 CheatAction -cheatActions = - Map.fromList - [ action "ffi(string[])" $ - \sig outOffset outSize input -> do - vm <- get - if view EVM.allowFFI vm then - case decodeBuffer [AbiArrayDynamicType AbiStringType] input of - CAbi valsArr -> case valsArr of - [AbiArrayDynamic AbiStringType strsV] -> - let - cmd = (flip fmap) (V.toList strsV) (\case - (AbiString a) -> unpack $ decodeUtf8 a - _ -> "") - cont bs = do - let encoded = ConcreteBuffer bs - assign (state . returndata) encoded - copyBytesToMemory encoded outSize 0 outOffset - assign result Nothing - in assign result (Just . VMFailure . Query $ (PleaseDoFFI cmd cont)) - _ -> vmError (BadCheatCode sig) - _ -> vmError (BadCheatCode sig) - else - let msg = encodeUtf8 "ffi disabled: run again with --ffi if you want to allow tests to call external scripts" - in vmError . Revert $ abiMethod "Error(string)" (AbiTuple . V.fromList $ [AbiString msg]), - - action "warp(uint256)" $ - \sig _ _ input -> case decodeStaticArgs input of - [x] -> assign (block . timestamp) x - _ -> vmError (BadCheatCode sig), - - action "roll(uint256)" $ - \sig _ _ input -> case decodeStaticArgs input of - [x] -> forceConcrete x (assign (block . number)) - _ -> vmError (BadCheatCode sig), - - action "store(address,bytes32,bytes32)" $ - \sig _ _ input -> case decodeStaticArgs input of - [a, slot, new] -> - makeUnique a $ \(C _ (num -> a')) -> - fetchAccount a' $ \_ -> do - modifying (env . contracts . ix a' . storage) (writeStorage slot new) - _ -> vmError (BadCheatCode sig), - - action "load(address,bytes32)" $ - \sig outOffset _ input -> case decodeStaticArgs input of - [a, slot] -> - makeUnique a $ \(C _ (num -> a'))-> - accessStorage a' slot $ \res -> do - assign (state . returndata . word256At 0) res - assign (state . memory . word256At outOffset) res - _ -> vmError (BadCheatCode sig), - - action "sign(uint256,bytes32)" $ - \sig outOffset _ input -> case decodeStaticArgs input of - [sk, hash] -> - forceConcrete sk $ \sk' -> - forceConcrete hash $ \(C _ hash') -> let - curve = getCurveByName SEC_p256k1 - priv = PrivateKey curve (num sk') - digest = digestFromByteString (word256Bytes hash') - in do - case digest of - Nothing -> vmError (BadCheatCode sig) - Just digest' -> do - let s = ethsign priv digest' - v = if (sign_s s) % 2 == 0 then 27 else 28 - encoded = encodeAbiValue $ - AbiTuple (RegularVector.fromList - [ AbiUInt 8 v - , AbiBytes 32 (word256Bytes . fromInteger $ sign_r s) - , AbiBytes 32 (word256Bytes . fromInteger $ sign_s s) - ]) - assign (state . returndata) (ConcreteBuffer encoded) - copyBytesToMemory (ConcreteBuffer encoded) (num . BS.length $ encoded) 0 outOffset - _ -> vmError (BadCheatCode sig), - - action "addr(uint256)" $ - \sig outOffset _ input -> case decodeStaticArgs input of - [sk] -> forceConcrete sk $ \sk' -> let - curve = getCurveByName SEC_p256k1 - pubPoint = generateQ curve (num sk') - encodeInt = encodeAbiValue . AbiUInt 256 . fromInteger - in do - case pubPoint of - PointO -> do vmError (BadCheatCode sig) - Point x y -> do - -- See yellow paper #286 - let - pub = BS.concat [ encodeInt x, encodeInt y ] - addr = w256lit . num . word256 . BS.drop 12 . BS.take 32 . keccakBytes $ pub - assign (state . returndata . word256At 0) addr - assign (state . memory . word256At outOffset) addr - _ -> vmError (BadCheatCode sig) - - ] - where - action s f = (abiKeccak s, f (Just $ abiKeccak s)) - --- | Hack deterministic signing, totally insecure... -ethsign :: PrivateKey -> Digest Crypto.Keccak_256 -> Signature -ethsign sk digest = go 420 - where - go k = case signDigestWith k sk digest of - Nothing -> go (k + 1) - Just sig -> sig - --- * General call implementation ("delegateCall") --- note that the continuation is ignored in the precompile case -delegateCall - :: (?op :: Word8) - => Contract -> Word -> SAddr -> SAddr -> Word -> Word -> Word -> Word -> Word -> [SymWord] - -> (Addr -> EVM ()) - -> EVM () -delegateCall this gasGiven (SAddr xTo) (SAddr xContext) xValue xInOffset xInSize xOutOffset xOutSize xs continue = - makeUnique (S (Todo "xTo" []) $ sFromIntegral xTo) $ \(C _ (num -> xTo')) -> - makeUnique (S (Todo "xcontext" []) $ sFromIntegral xContext) $ \(C _ (num -> xContext')) -> - if xTo' > 0 && xTo' <= 9 - then precompiledContract this gasGiven xTo' xContext' xValue xInOffset xInSize xOutOffset xOutSize xs - else if num xTo' == cheatCode then - do - assign (state . stack) xs - cheat (xInOffset, xInSize) (xOutOffset, xOutSize) - else - callChecks this gasGiven xContext' xTo' xValue xInOffset xInSize xOutOffset xOutSize xs $ - \xGas -> do - vm0 <- get - fetchAccount xTo' $ \target -> - burn xGas $ do - let newContext = CallContext - { callContextTarget = xTo' - , callContextContext = xContext' - , callContextOffset = xOutOffset - , callContextSize = xOutSize - , callContextCodehash = view codehash target - , callContextReversion = view (env . contracts) vm0 - , callContextSubState = view (tx . substate) vm0 - , callContextAbi = - if xInSize >= 4 - then case unliteral $ readMemoryWord32 xInOffset (view (state . memory) vm0) - of Nothing -> Nothing - Just abi -> Just . w256 $ num abi - else Nothing - , callContextData = (readMemory (num xInOffset) (num xInSize) vm0) - } - - pushTrace (FrameTrace newContext) - next - vm1 <- get - - pushTo frames $ Frame - { _frameState = (set stack xs) (view state vm1) - , _frameContext = newContext - } - - zoom state $ do - assign gas (num xGas) - assign pc 0 - assign code (view bytecode target) - assign codeContract xTo' - assign stack mempty - assign memory mempty - assign memorySize 0 - assign returndata mempty - assign calldata (readMemory (num xInOffset) (num xInSize) vm0, w256lit (num xInSize)) - - continue xTo' - --- -- * Contract creation - --- EIP 684 -collision :: Maybe Contract -> Bool -collision c' = case c' of - Just c -> (view nonce c /= 0) || case view contractcode c of - RuntimeCode b -> len b /= 0 - _ -> True - Nothing -> False - -create :: (?op :: Word8) - => Addr -> Contract - -> Word -> Word -> [SymWord] -> Addr -> Buffer -> EVM () -create self this xGas' xValue xs newAddr initCode = do - vm0 <- get - let xGas = num xGas' - if xValue > view balance this - then do - assign (state . stack) (0 : xs) - assign (state . returndata) mempty - pushTrace $ ErrorTrace $ BalanceTooLow xValue (view balance this) - next - else if length (view frames vm0) >= 1024 - then do - assign (state . stack) (0 : xs) - assign (state . returndata) mempty - pushTrace $ ErrorTrace CallDepthLimitReached - next - else if collision $ view (env . contracts . at newAddr) vm0 - then burn xGas $ do - assign (state . stack) (0 : xs) - modifying (env . contracts . ix self . nonce) succ - next - else burn xGas $ do - touchAccount self - touchAccount newAddr - let - store = case view (env . storageModel) vm0 of - ConcreteS -> Concrete mempty - SymbolicS -> Symbolic [] $ sListArray 0 [] - InitialS -> Symbolic [] $ sListArray 0 [] - newContract = - initialContract (InitCode initCode) & set storage store - newContext = - CreationContext { creationContextAddress = newAddr - , creationContextCodehash = view codehash newContract - , creationContextReversion = view (env . contracts) vm0 - , creationContextSubstate = view (tx . substate) vm0 - } - - zoom (env . contracts) $ do - oldAcc <- use (at newAddr) - let oldBal = maybe 0 (view balance) oldAcc - - assign (at newAddr) (Just (newContract & balance .~ oldBal)) - modifying (ix self . nonce) succ - - transfer self newAddr xValue - - pushTrace (FrameTrace newContext) - next - vm1 <- get - pushTo frames $ Frame - { _frameContext = newContext - , _frameState = (set stack xs) (view state vm1) - } - - assign state $ - blankState - & set contract newAddr - & set codeContract newAddr - & set code initCode - & set callvalue (litWord xValue) - & set caller (litAddr self) - & set gas xGas' - --- | Replace a contract's code, like when CREATE returns --- from the constructor code. -replaceCode :: Addr -> ContractCode -> EVM () -replaceCode target newCode = - zoom (env . contracts . at target) $ - get >>= \case - Just now -> case (view contractcode now) of - InitCode _ -> - put . Just $ - initialContract newCode - & set storage (view storage now) - & set balance (view balance now) - & set nonce (view nonce now) - RuntimeCode _ -> - error ("internal error: can't replace code of deployed contract " <> show target) - Nothing -> - error "internal error: can't replace code of nonexistent contract" - -replaceCodeOfSelf :: ContractCode -> EVM () -replaceCodeOfSelf newCode = do - vm <- get - replaceCode (view (state . contract) vm) newCode - -resetState :: EVM () -resetState = do - assign result Nothing - assign frames [] - assign state blankState - - --- * VM error implementation - -vmError :: Error -> EVM () -vmError e = finishFrame (FrameErrored e) - -underrun :: EVM () -underrun = vmError StackUnderrun - --- | A stack frame can be popped in three ways. -data FrameResult - = FrameReturned Buffer -- ^ STOP, RETURN, or no more code - | FrameReverted Buffer -- ^ REVERT - | FrameErrored Error -- ^ Any other error - deriving Show - --- | This function defines how to pop the current stack frame in either of --- the ways specified by 'FrameResult'. --- --- It also handles the case when the current stack frame is the only one; --- in this case, we set the final '_result' of the VM execution. -finishFrame :: FrameResult -> EVM () -finishFrame how = do - oldVm <- get - - case view frames oldVm of - -- Is the current frame the only one? - [] -> do - case how of - FrameReturned output -> assign result . Just $ VMSuccess output - FrameReverted buffer -> forceConcreteBuffer buffer $ \out -> assign result . Just $ VMFailure (Revert out) - FrameErrored e -> assign result . Just $ VMFailure e - finalize - - -- Are there some remaining frames? - nextFrame : remainingFrames -> do - - -- Insert a debug trace. - insertTrace $ - case how of - FrameErrored e -> - ErrorTrace e - FrameReverted (ConcreteBuffer output) -> - ErrorTrace (Revert output) - FrameReverted (SymbolicBuffer output) -> - ErrorTrace (Revert (forceLitBytes output)) - FrameReturned output -> - ReturnTrace output (view frameContext nextFrame) - -- Pop to the previous level of the debug trace stack. - popTrace - - -- Pop the top frame. - assign frames remainingFrames - -- Install the state of the frame to which we shall return. - assign state (view frameState nextFrame) - - -- When entering a call, the gas allowance is counted as burned - -- in advance; this unburns the remainder and adds it to the - -- parent frame. - let remainingGas = view (state . gas) oldVm - reclaimRemainingGasAllowance = do - modifying burned (subtract remainingGas) - modifying (state . gas) (+ remainingGas) - - FeeSchedule {..} = view ( block . schedule ) oldVm - - -- Now dispatch on whether we were creating or calling, - -- and whether we shall return, revert, or error (six cases). - case view frameContext nextFrame of - - -- Were we calling? - CallContext _ _ (num -> outOffset) (num -> outSize) _ _ _ reversion substate' -> do - - -- Excerpt K.1. from the yellow paper: - -- K.1. Deletion of an Account Despite Out-of-gas. - -- At block 2675119, in the transaction 0xcf416c536ec1a19ed1fb89e4ec7ffb3cf73aa413b3aa9b77d60e4fd81a4296ba, - -- an account at address 0x03 was called and an out-of-gas occurred during the call. - -- Against the equation (197), this added 0x03 in the set of touched addresses, and this transaction turned σ[0x03] into ∅. - - -- In other words, we special case address 0x03 and keep it in the set of touched accounts during revert - touched <- use (tx . substate . touchedAccounts) - - let - substate'' = over touchedAccounts (maybe id cons (find ((==) 3) touched)) substate' - revertContracts = assign (env . contracts) reversion - revertSubstate = assign (tx . substate) substate'' - - case how of - -- Case 1: Returning from a call? - FrameReturned output -> do - assign (state . returndata) output - copyCallBytesToMemory output outSize 0 outOffset - reclaimRemainingGasAllowance - push 1 - - -- Case 2: Reverting during a call? - FrameReverted output -> do - revertContracts - revertSubstate - assign (state . returndata) output - copyCallBytesToMemory output outSize 0 outOffset - reclaimRemainingGasAllowance - push 0 - - -- Case 3: Error during a call? - FrameErrored _ -> do - revertContracts - revertSubstate - assign (state . returndata) mempty - push 0 - -- Or were we creating? - CreationContext _ _ reversion substate' -> do - creator <- use (state . contract) - let - createe = view (state . contract) oldVm - revertContracts = assign (env . contracts) reversion' - revertSubstate = assign (tx . substate) substate' - - -- persist the nonce through the reversion - reversion' = (Map.adjust (over nonce (+ 1)) creator) reversion - - case how of - -- Case 4: Returning during a creation? - FrameReturned output -> do - replaceCode createe (RuntimeCode output) - assign (state . returndata) mempty - reclaimRemainingGasAllowance - push (num createe) - - -- Case 5: Reverting during a creation? - FrameReverted output -> do - revertContracts - revertSubstate - assign (state . returndata) output - reclaimRemainingGasAllowance - push 0 - - -- Case 6: Error during a creation? - FrameErrored _ -> do - revertContracts - revertSubstate - assign (state . returndata) mempty - push 0 - - --- * Memory helpers - -accessUnboundedMemoryRange - :: FeeSchedule Integer - -> Word - -> Word - -> EVM () - -> EVM () -accessUnboundedMemoryRange _ _ 0 continue = continue -accessUnboundedMemoryRange fees f l continue = do - m0 <- num <$> use (state . memorySize) - do - let m1 = 32 * ceilDiv (max m0 (num f + num l)) 32 - burn (memoryCost fees m1 - memoryCost fees m0) $ do - assign (state . memorySize) (num m1) - continue - -accessMemoryRange - :: FeeSchedule Integer - -> Word - -> Word - -> EVM () - -> EVM () -accessMemoryRange _ _ 0 continue = continue -accessMemoryRange fees f l continue = - if f + l < l - then vmError IllegalOverflow - else accessUnboundedMemoryRange fees f l continue - -accessMemoryWord - :: FeeSchedule Integer -> Word -> EVM () -> EVM () -accessMemoryWord fees x = accessMemoryRange fees x 32 - -copyBytesToMemory - :: Buffer -> Word -> Word -> Word -> EVM () -copyBytesToMemory bs size xOffset yOffset = - if size == 0 then noop - else do - mem <- use (state . memory) - assign (state . memory) $ - writeMemory bs size xOffset yOffset mem - -copyCallBytesToMemory - :: Buffer -> Word -> Word -> Word -> EVM () -copyCallBytesToMemory bs size xOffset yOffset = - if size == 0 then noop - else do - mem <- use (state . memory) - assign (state . memory) $ - writeMemory bs (min size (num (len bs))) xOffset yOffset mem - -readMemory :: Word -> Word -> VM -> Buffer -readMemory offset size vm = sliceWithZero (num offset) (num size) (view (state . memory) vm) - -word256At - :: Functor f - => Word -> (SymWord -> f (SymWord)) - -> Buffer -> f Buffer -word256At i = lens getter setter where - getter = EVM.Symbolic.readMemoryWord i - setter m x = setMemoryWord i x m - --- * Tracing - -withTraceLocation - :: (MonadState VM m) => TraceData -> m Trace -withTraceLocation x = do - vm <- get - let - Just this = - currentContract vm - pure Trace - { _traceData = x - , _traceContract = this - , _traceOpIx = fromMaybe 0 $ (view opIxMap this) Vector.!? (view (state . pc) vm) - } - -pushTrace :: TraceData -> EVM () -pushTrace x = do - trace <- withTraceLocation x - modifying traces $ - \t -> Zipper.children $ Zipper.insert (Node trace []) t - -insertTrace :: TraceData -> EVM () -insertTrace x = do - trace <- withTraceLocation x - modifying traces $ - \t -> Zipper.nextSpace $ Zipper.insert (Node trace []) t - -popTrace :: EVM () -popTrace = - modifying traces $ - \t -> case Zipper.parent t of - Nothing -> error "internal error (trace root)" - Just t' -> Zipper.nextSpace t' - -zipperRootForest :: Zipper.TreePos Zipper.Empty a -> Forest a -zipperRootForest z = - case Zipper.parent z of - Nothing -> Zipper.toForest z - Just z' -> zipperRootForest (Zipper.nextSpace z') - -traceForest :: VM -> Forest Trace -traceForest = view (traces . to zipperRootForest) - -traceLog :: (MonadState VM m) => Log -> m () -traceLog log = do - trace <- withTraceLocation (EventTrace log) - modifying traces $ - \t -> Zipper.nextSpace (Zipper.insert (Node trace []) t) - --- * Stack manipulation - -push :: Word -> EVM () -push = pushSym . w256lit . num - -pushSym :: SymWord -> EVM () -pushSym x = state . stack %= (x :) - - -stackOp1 - :: (?op :: Word8) - => ((SymWord) -> Integer) - -> ((SymWord) -> (SymWord)) - -> EVM () -stackOp1 cost f = - use (state . stack) >>= \case - (x:xs) -> - burn (cost x) $ do - next - let !y = f x - state . stack .= y : xs - _ -> - underrun - -stackOp2 - :: (?op :: Word8) - => (((SymWord), (SymWord)) -> Integer) - -> (((SymWord), (SymWord)) -> (SymWord)) - -> EVM () -stackOp2 cost f = - use (state . stack) >>= \case - (x:y:xs) -> - burn (cost (x, y)) $ do - next - state . stack .= f (x, y) : xs - _ -> - underrun - -stackOp3 - :: (?op :: Word8) - => (((SymWord), (SymWord), (SymWord)) -> Integer) - -> (((SymWord), (SymWord), (SymWord)) -> (SymWord)) - -> EVM () -stackOp3 cost f = - use (state . stack) >>= \case - (x:y:z:xs) -> - burn (cost (x, y, z)) $ do - next - state . stack .= f (x, y, z) : xs - _ -> - underrun - --- * Bytecode data functions - -checkJump :: (Integral n) => n -> [SymWord] -> EVM () -checkJump x xs = do - theCode <- use (state . code) - self <- use (state . codeContract) - theCodeOps <- use (env . contracts . ix self . codeOps) - theOpIxMap <- use (env . contracts . ix self . opIxMap) - if x < num (len theCode) && 0x5b == (fromMaybe (error "tried to jump to symbolic code location") $ unliteral $ EVM.Symbolic.index (num x) theCode) - then - if OpJumpdest == snd (theCodeOps RegularVector.! (theOpIxMap Vector.! num x)) - then do - state . stack .= xs - state . pc .= num x - else - vmError BadJumpDestination - else vmError BadJumpDestination - -opSize :: Word8 -> Int -opSize x | x >= 0x60 && x <= 0x7f = num x - 0x60 + 2 -opSize _ = 1 - --- Index i of the resulting vector contains the operation index for --- the program counter value i. This is needed because source map --- entries are per operation, not per byte. -mkOpIxMap :: Buffer -> Vector Int -mkOpIxMap xs = Vector.create $ Vector.new (len xs) >>= \v -> - -- Loop over the byte string accumulating a vector-mutating action. - -- This is somewhat obfuscated, but should be fast. - case xs of - ConcreteBuffer xs' -> - let (_, _, _, m) = - BS.foldl' (go v) (0 :: Word8, 0, 0, return ()) xs' - in m >> return v - SymbolicBuffer xs' -> - let (_, _, _, m) = - foldl (go' v) (0, 0, 0, return ()) (stripBytecodeMetadataSym xs') - in m >> return v - - where - -- concrete case - go v (0, !i, !j, !m) x | x >= 0x60 && x <= 0x7f = - {- Start of PUSH op. -} (x - 0x60 + 1, i + 1, j, m >> Vector.write v i j) - go v (1, !i, !j, !m) _ = - {- End of PUSH op. -} (0, i + 1, j + 1, m >> Vector.write v i j) - go v (0, !i, !j, !m) _ = - {- Other op. -} (0, i + 1, j + 1, m >> Vector.write v i j) - go v (n, !i, !j, !m) _ = - {- PUSH data. -} (n - 1, i + 1, j, m >> Vector.write v i j) - - -- symbolic case - go' v (0, !i, !j, !m) x = case unliteral x of - Just x' -> if x' >= 0x60 && x' <= 0x7f - -- start of PUSH op -- - then (x' - 0x60 + 1, i + 1, j, m >> Vector.write v i j) - -- other data -- - else (0, i + 1, j + 1, m >> Vector.write v i j) - _ -> error "cannot analyze symbolic code" - - {- Start of PUSH op. -} (x - 0x60 + 1, i + 1, j, m >> Vector.write v i j) - go' v (1, !i, !j, !m) _ = - {- End of PUSH op. -} (0, i + 1, j + 1, m >> Vector.write v i j) - go' v (n, !i, !j, !m) _ = - {- PUSH data. -} (n - 1, i + 1, j, m >> Vector.write v i j) - -vmOp :: VM -> Maybe Op -vmOp vm = - let i = vm ^. state . pc - code' = vm ^. state . code - xs = case code' of - ConcreteBuffer xs' -> ConcreteBuffer (BS.drop i xs') - SymbolicBuffer xs' -> SymbolicBuffer (drop i xs') - op = case xs of - ConcreteBuffer b -> BS.index b 0 - SymbolicBuffer b -> fromSized $ fromMaybe (error "unexpected symbolic code") (unliteral (b !! 0)) - in if (len code' < i) - then Nothing - else Just (readOp op xs) - -vmOpIx :: VM -> Maybe Int -vmOpIx vm = - do self <- currentContract vm - (view opIxMap self) Vector.!? (view (state . pc) vm) - -opParams :: VM -> Map String (SymWord) -opParams vm = - case vmOp vm of - Just OpCreate -> - params $ words "value offset size" - Just OpCall -> - params $ words "gas to value in-offset in-size out-offset out-size" - Just OpSstore -> - params $ words "index value" - Just OpCodecopy -> - params $ words "mem-offset code-offset code-size" - Just OpSha3 -> - params $ words "offset size" - Just OpCalldatacopy -> - params $ words "to from size" - Just OpExtcodecopy -> - params $ words "account mem-offset code-offset code-size" - Just OpReturn -> - params $ words "offset size" - Just OpJumpi -> - params $ words "destination condition" - _ -> mempty - where - params xs = - if length (vm ^. state . stack) >= length xs - then Map.fromList (zip xs (vm ^. state . stack)) - else mempty - -readOp :: Word8 -> Buffer -> Op -readOp x _ | x >= 0x80 && x <= 0x8f = OpDup (x - 0x80 + 1) -readOp x _ | x >= 0x90 && x <= 0x9f = OpSwap (x - 0x90 + 1) -readOp x _ | x >= 0xa0 && x <= 0xa4 = OpLog (x - 0xa0) -readOp x xs | x >= 0x60 && x <= 0x7f = - let n = x - 0x60 + 1 - xs'' = case xs of - ConcreteBuffer xs' -> num $ EVM.Concrete.readMemoryWord 0 $ BS.take (num n) xs' - SymbolicBuffer xs' -> readSWord' 0 $ take (num n) xs' - in OpPush xs'' -readOp x _ = case x of - 0x00 -> OpStop - 0x01 -> OpAdd - 0x02 -> OpMul - 0x03 -> OpSub - 0x04 -> OpDiv - 0x05 -> OpSdiv - 0x06 -> OpMod - 0x07 -> OpSmod - 0x08 -> OpAddmod - 0x09 -> OpMulmod - 0x0a -> OpExp - 0x0b -> OpSignextend - 0x10 -> OpLt - 0x11 -> OpGt - 0x12 -> OpSlt - 0x13 -> OpSgt - 0x14 -> OpEq - 0x15 -> OpIszero - 0x16 -> OpAnd - 0x17 -> OpOr - 0x18 -> OpXor - 0x19 -> OpNot - 0x1a -> OpByte - 0x1b -> OpShl - 0x1c -> OpShr - 0x1d -> OpSar - 0x20 -> OpSha3 - 0x30 -> OpAddress - 0x31 -> OpBalance - 0x32 -> OpOrigin - 0x33 -> OpCaller - 0x34 -> OpCallvalue - 0x35 -> OpCalldataload - 0x36 -> OpCalldatasize - 0x37 -> OpCalldatacopy - 0x38 -> OpCodesize - 0x39 -> OpCodecopy - 0x3a -> OpGasprice - 0x3b -> OpExtcodesize - 0x3c -> OpExtcodecopy - 0x3d -> OpReturndatasize - 0x3e -> OpReturndatacopy - 0x3f -> OpExtcodehash - 0x40 -> OpBlockhash - 0x41 -> OpCoinbase - 0x42 -> OpTimestamp - 0x43 -> OpNumber - 0x44 -> OpDifficulty - 0x45 -> OpGaslimit - 0x46 -> OpChainid - 0x47 -> OpSelfbalance - 0x50 -> OpPop - 0x51 -> OpMload - 0x52 -> OpMstore - 0x53 -> OpMstore8 - 0x54 -> OpSload - 0x55 -> OpSstore - 0x56 -> OpJump - 0x57 -> OpJumpi - 0x58 -> OpPc - 0x59 -> OpMsize - 0x5a -> OpGas - 0x5b -> OpJumpdest - 0xf0 -> OpCreate - 0xf1 -> OpCall - 0xf2 -> OpCallcode - 0xf3 -> OpReturn - 0xf4 -> OpDelegatecall - 0xf5 -> OpCreate2 - 0xfd -> OpRevert - 0xfa -> OpStaticcall - 0xff -> OpSelfdestruct - _ -> OpUnknown x - -mkCodeOps :: Buffer -> RegularVector.Vector (Int, Op) -mkCodeOps (ConcreteBuffer bytes) = RegularVector.fromList . toList $ go 0 bytes - where - go !i !xs = - case BS.uncons xs of - Nothing -> - mempty - Just (x, xs') -> - let j = opSize x - in (i, readOp x (ConcreteBuffer xs')) Seq.<| go (i + j) (BS.drop j xs) -mkCodeOps (SymbolicBuffer bytes) = RegularVector.fromList . toList $ go' 0 (stripBytecodeMetadataSym bytes) - where - go' !i !xs = - case uncons xs of - Nothing -> - mempty - Just (x, xs') -> - let x' = fromSized $ fromMaybe (error "unexpected symbolic code argument") $ unliteral x - j = opSize x' - in (i, readOp x' (SymbolicBuffer xs')) Seq.<| go' (i + j) (drop j xs) - --- * Gas cost calculation helpers - --- Gas cost function for CALL, transliterated from the Yellow Paper. -costOfCall - :: FeeSchedule Integer - -> Bool -> Word -> Word -> Word -> Addr - -> EVM (Integer, Integer) -costOfCall (FeeSchedule {..}) recipientExists xValue availableGas' xGas' target = do - acc <- accessAccountForGas target - let call_base_gas = if acc then g_warm_storage_read else g_cold_account_access - availableGas = num availableGas' - xGas = num xGas' - c_new = if not recipientExists && xValue /= 0 - then num g_newaccount - else 0 - c_xfer = if xValue /= 0 then num g_callvalue else 0 - c_extra = num call_base_gas + c_xfer + c_new - c_gascap = if availableGas >= c_extra - then min xGas (allButOne64th (availableGas - c_extra)) - else xGas - c_callgas = if xValue /= 0 then c_gascap + num g_callstipend else c_gascap - return (c_gascap + c_extra, c_callgas) - --- Gas cost of create, including hash cost if needed -costOfCreate - :: FeeSchedule Integer - -> Word -> Word -> (Integer, Integer) -costOfCreate (FeeSchedule {..}) availableGas' hashSize = - (createCost + initGas, initGas) - where - availableGas = num availableGas' - createCost = g_create + hashCost - hashCost = g_sha3word * ceilDiv (num hashSize) 32 - initGas = allButOne64th (availableGas - createCost) - -concreteModexpGasFee :: ByteString -> Integer -concreteModexpGasFee input = max 200 ((multiplicationComplexity * iterCount) `div` 3) - where (lenb, lene, lenm) = parseModexpLength input - ez = isZero (96 + lenb) lene input - e' = w256 $ word $ LS.toStrict $ - lazySlice (96 + lenb) (min 32 lene) input - nwords :: Integer - nwords = ceilDiv (num $ max lenb lenm) 8 - multiplicationComplexity = nwords * nwords - iterCount' :: Integer - iterCount' | lene <= 32 && ez = 0 - | lene <= 32 = num (log2 e') - | e' == 0 = 8 * (num lene - 32) - | otherwise = num (log2 e') + 8 * (num lene - 32) - iterCount = max iterCount' 1 - --- Gas cost of precompiles -costOfPrecompile :: FeeSchedule Integer -> Addr -> Buffer -> Integer -costOfPrecompile (FeeSchedule {..}) precompileAddr input = - case precompileAddr of - -- ECRECOVER - 0x1 -> 3000 - -- SHA2-256 - 0x2 -> num $ (((len input + 31) `div` 32) * 12) + 60 - -- RIPEMD-160 - 0x3 -> num $ (((len input + 31) `div` 32) * 120) + 600 - -- IDENTITY - 0x4 -> num $ (((len input + 31) `div` 32) * 3) + 15 - -- MODEXP - 0x5 -> concreteModexpGasFee input' - where input' = case input of - SymbolicBuffer _ -> error "unsupported: symbolic MODEXP gas cost calc" - ConcreteBuffer b -> b - -- ECADD - 0x6 -> g_ecadd - -- ECMUL - 0x7 -> g_ecmul - -- ECPAIRING - 0x8 -> num $ ((len input) `div` 192) * (num g_pairing_point) + (num g_pairing_base) - -- BLAKE2 - 0x9 -> let input' = case input of - SymbolicBuffer _ -> error "unsupported: symbolic BLAKE2B gas cost calc" - ConcreteBuffer b -> b - in g_fround * (num $ asInteger $ lazySlice 0 4 input') - _ -> error ("unimplemented precompiled contract " ++ show precompileAddr) - --- Gas cost of memory expansion -memoryCost :: FeeSchedule Integer -> Integer -> Integer -memoryCost FeeSchedule{..} byteCount = - let - wordCount = ceilDiv byteCount 32 - linearCost = g_memory * wordCount - quadraticCost = div (wordCount * wordCount) 512 - in - linearCost + quadraticCost - --- * Arithmetic - -ceilDiv :: (Num a, Integral a) => a -> a -> a -ceilDiv m n = div (m + n - 1) n - -allButOne64th :: (Num a, Integral a) => a -> a -allButOne64th n = n - div n 64 - -log2 :: FiniteBits b => b -> Int -log2 x = finiteBitSize x - 1 - countLeadingZeros x - - --- * Emacs setup - --- Local Variables: --- outline-regexp: "-- \\*+\\|data \\|newtype \\|type \\| +-- op: " --- outline-heading-alist: --- (("-- *" . 1) ("data " . 2) ("newtype " . 2) ("type " . 2)) --- compile-command: "make" --- End: diff --git a/src/hevm/src/EVM/ABI.hs b/src/hevm/src/EVM/ABI.hs deleted file mode 100644 index b459b2073..000000000 --- a/src/hevm/src/EVM/ABI.hs +++ /dev/null @@ -1,570 +0,0 @@ -{- - - The ABI encoding is mostly straightforward. - - Definition: an int-like value is an uint, int, boolean, or address. - - Basic encoding: - - * Int-likes and length prefixes are big-endian. - * All values are right-0-padded to multiples of 256 bits. - - Bytestrings are padded as a whole; e.g., bytes[33] takes 64 bytes. - * Dynamic-length sequences are prefixed with their length. - - Sequences are encoded as a head followed by a tail, thus: - - * the tail is the concatenation of encodings of non-int-like items. - * the head has 256 bits per sequence item, thus: - - int-likes are stored directly; - - non-int-likes are stored as byte offsets into the tail, - starting from the beginning of the head. - - Nested sequences are encoded recursively with no special treatment. - - Calldata args are encoded as heterogenous sequences sans length prefix. - --} - -{-# Language StrictData #-} -{-# Language DataKinds #-} - -module EVM.ABI - ( AbiValue (..) - , AbiType (..) - , AbiKind (..) - , AbiVals (..) - , abiKind - , Event (..) - , SolError (..) - , Anonymity (..) - , Indexed (..) - , putAbi - , getAbi - , getAbiSeq - , genAbiValue - , abiValueType - , abiTypeSolidity - , abiMethod - , emptyAbi - , encodeAbiValue - , decodeAbiValue - , decodeStaticArgs - , decodeBuffer - , formatString - , parseTypeName - , makeAbiValue - , parseAbiValue - , selector - ) where - -import EVM.Types - -import Control.Monad (replicateM, replicateM_, forM_, void) -import Data.Binary.Get (Get, runGet, runGetOrFail, label, getWord8, getWord32be, skip) -import Data.Binary.Put (Put, runPut, putWord8, putWord32be) -import Data.Bits (shiftL, shiftR, (.&.)) -import Data.ByteString (ByteString) -import Data.Char (isHexDigit) -import Data.DoubleWord (Word256, Int256, signedWord) -import Data.Functor (($>)) -import Data.Text (Text, pack, unpack) -import Data.Text.Encoding (encodeUtf8, decodeUtf8') -import Data.Vector (Vector, toList) -import Data.Word (Word32) -import Data.List (intercalate) -import Data.SBV (fromBytes) -import GHC.Generics - -import Test.QuickCheck hiding ((.&.), label) -import Text.ParserCombinators.ReadP -import Control.Applicative - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as BS16 -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.ByteString.Lazy as BSLazy -import qualified Data.Text as Text -import qualified Data.Vector as Vector - -import qualified Text.Megaparsec as P -import qualified Text.Megaparsec.Char as P - -data AbiValue - = AbiUInt Int Word256 - | AbiInt Int Int256 - | AbiAddress Addr - | AbiBool Bool - | AbiBytes Int BS.ByteString - | AbiBytesDynamic BS.ByteString - | AbiString BS.ByteString - | AbiArrayDynamic AbiType (Vector AbiValue) - | AbiArray Int AbiType (Vector AbiValue) - | AbiTuple (Vector AbiValue) - deriving (Read, Eq, Ord, Generic) - --- | Pretty-print some 'AbiValue'. -instance Show AbiValue where - show (AbiUInt _ n) = show n - show (AbiInt _ n) = show n - show (AbiAddress n) = show n - show (AbiBool b) = if b then "true" else "false" - show (AbiBytes _ b) = show (ByteStringS b) - show (AbiBytesDynamic b) = show (ByteStringS b) - show (AbiString s) = formatString s - show (AbiArrayDynamic _ v) = - "[" ++ intercalate ", " (show <$> Vector.toList v) ++ "]" - show (AbiArray _ _ v) = - "[" ++ intercalate ", " (show <$> Vector.toList v) ++ "]" - show (AbiTuple v) = - "(" ++ intercalate ", " (show <$> Vector.toList v) ++ ")" - -formatString :: ByteString -> String -formatString bs = - case decodeUtf8' (fst (BS.spanEnd (== 0) bs)) of - Right s -> "\"" <> unpack s <> "\"" - Left _ -> "❮utf8 decode failed❯: " <> (show $ ByteStringS bs) - -data AbiType - = AbiUIntType Int - | AbiIntType Int - | AbiAddressType - | AbiBoolType - | AbiBytesType Int - | AbiBytesDynamicType - | AbiStringType - | AbiArrayDynamicType AbiType - | AbiArrayType Int AbiType - | AbiTupleType (Vector AbiType) - deriving (Read, Eq, Ord, Generic) - -instance Show AbiType where - show = Text.unpack . abiTypeSolidity - -data AbiKind = Dynamic | Static - deriving (Show, Read, Eq, Ord, Generic) - -data Anonymity = Anonymous | NotAnonymous - deriving (Show, Ord, Eq, Generic) -data Indexed = Indexed | NotIndexed - deriving (Show, Ord, Eq, Generic) -data Event = Event Text Anonymity [(Text, AbiType, Indexed)] - deriving (Show, Ord, Eq, Generic) -data SolError = SolError Text [AbiType] - deriving (Show, Ord, Eq, Generic) - -abiKind :: AbiType -> AbiKind -abiKind = \case - AbiBytesDynamicType -> Dynamic - AbiStringType -> Dynamic - AbiArrayDynamicType _ -> Dynamic - AbiArrayType _ t -> abiKind t - AbiTupleType ts -> if Dynamic `elem` (abiKind <$> ts) then Dynamic else Static - _ -> Static - -abiValueType :: AbiValue -> AbiType -abiValueType = \case - AbiUInt n _ -> AbiUIntType n - AbiInt n _ -> AbiIntType n - AbiAddress _ -> AbiAddressType - AbiBool _ -> AbiBoolType - AbiBytes n _ -> AbiBytesType n - AbiBytesDynamic _ -> AbiBytesDynamicType - AbiString _ -> AbiStringType - AbiArrayDynamic t _ -> AbiArrayDynamicType t - AbiArray n t _ -> AbiArrayType n t - AbiTuple v -> AbiTupleType (abiValueType <$> v) - -abiTypeSolidity :: AbiType -> Text -abiTypeSolidity = \case - AbiUIntType n -> "uint" <> pack (show n) - AbiIntType n -> "int" <> pack (show n) - AbiAddressType -> "address" - AbiBoolType -> "bool" - AbiBytesType n -> "bytes" <> pack (show n) - AbiBytesDynamicType -> "bytes" - AbiStringType -> "string" - AbiArrayDynamicType t -> abiTypeSolidity t <> "[]" - AbiArrayType n t -> abiTypeSolidity t <> "[" <> pack (show n) <> "]" - AbiTupleType ts -> "(" <> (Text.intercalate "," . Vector.toList $ abiTypeSolidity <$> ts) <> ")" - -getAbi :: AbiType -> Get AbiValue -getAbi t = label (Text.unpack (abiTypeSolidity t)) $ - case t of - AbiUIntType n -> do - let word32Count = 8 * div (n + 255) 256 - xs <- replicateM word32Count getWord32be - pure (AbiUInt n (pack32 word32Count xs)) - - AbiIntType n -> asUInt n (AbiInt n) - AbiAddressType -> asUInt 256 AbiAddress - AbiBoolType -> asUInt 256 (AbiBool . (> (0 :: Integer))) - - AbiBytesType n -> - AbiBytes n <$> getBytesWith256BitPadding n - - AbiBytesDynamicType -> - AbiBytesDynamic <$> - (label "bytes length prefix" getWord256 - >>= label "bytes data" . getBytesWith256BitPadding) - - AbiStringType -> do - AbiString <$> - (label "string length prefix" getWord256 - >>= label "string data" . getBytesWith256BitPadding) - - AbiArrayType n t' -> - AbiArray n t' <$> getAbiSeq n (repeat t') - - AbiArrayDynamicType t' -> do - AbiUInt _ n <- label "array length" (getAbi (AbiUIntType 256)) - AbiArrayDynamic t' <$> - label "array body" (getAbiSeq (fromIntegral n) (repeat t')) - - AbiTupleType ts -> - AbiTuple <$> getAbiSeq (Vector.length ts) (Vector.toList ts) - -putAbi :: AbiValue -> Put -putAbi = \case - AbiUInt _ x -> - forM_ (reverse [0 .. 7]) $ \i -> - putWord32be (fromIntegral (shiftR x (i * 32) .&. 0xffffffff)) - - AbiInt n x -> putAbi (AbiUInt n (fromIntegral x)) - AbiAddress x -> putAbi (AbiUInt 160 (fromIntegral x)) - AbiBool x -> putAbi (AbiUInt 8 (if x then 1 else 0)) - - AbiBytes n xs -> do - forM_ [0 .. n-1] (putWord8 . BS.index xs) - replicateM_ (roundTo32Bytes n - n) (putWord8 0) - - AbiBytesDynamic xs -> do - let n = BS.length xs - putAbi (AbiUInt 256 (fromIntegral n)) - putAbi (AbiBytes n xs) - - AbiString s -> - putAbi (AbiBytesDynamic s) - - AbiArray _ _ xs -> - putAbiSeq xs - - AbiArrayDynamic _ xs -> do - putAbi (AbiUInt 256 (fromIntegral (Vector.length xs))) - putAbiSeq xs - - AbiTuple v -> - putAbiSeq v - --- | Decode a sequence type (e.g. tuple / array). Will fail for non sequence types -getAbiSeq :: Int -> [AbiType] -> Get (Vector AbiValue) -getAbiSeq n ts = label "sequence" $ do - hs <- label "sequence head" (getAbiHead n ts) - Vector.fromList <$> - label "sequence tail" (mapM (either getAbi pure) hs) - -getAbiHead :: Int -> [AbiType] - -> Get [Either AbiType AbiValue] -getAbiHead 0 _ = pure [] -getAbiHead _ [] = fail "ran out of types" -getAbiHead n (t:ts) = - case abiKind t of - Dynamic -> - (Left t :) <$> (skip 32 *> getAbiHead (n - 1) ts) - Static -> - do x <- getAbi t - xs <- getAbiHead (n - 1) ts - pure (Right x : xs) - -putAbiTail :: AbiValue -> Put -putAbiTail x = - case abiKind (abiValueType x) of - Static -> pure () - Dynamic -> putAbi x - -abiTailSize :: AbiValue -> Int -abiTailSize x = - case abiKind (abiValueType x) of - Static -> 0 - Dynamic -> - case x of - AbiString s -> 32 + roundTo32Bytes (BS.length s) - AbiBytesDynamic s -> 32 + roundTo32Bytes (BS.length s) - AbiArrayDynamic _ xs -> 32 + sum ((abiHeadSize <$> xs) <> (abiTailSize <$> xs)) - AbiArray _ _ xs -> sum ((abiHeadSize <$> xs) <> (abiTailSize <$> xs)) - AbiTuple v -> sum ((abiHeadSize <$> v) <> (abiTailSize <$> v)) - _ -> error "impossible" - -abiHeadSize :: AbiValue -> Int -abiHeadSize x = - case abiKind (abiValueType x) of - Dynamic -> 32 - Static -> - case x of - AbiUInt _ _ -> 32 - AbiInt _ _ -> 32 - AbiBytes n _ -> roundTo32Bytes n - AbiAddress _ -> 32 - AbiBool _ -> 32 - AbiTuple v -> sum (abiHeadSize <$> v) - AbiArray _ _ xs -> sum (abiHeadSize <$> xs) - _ -> error "impossible" - -putAbiSeq :: Vector AbiValue -> Put -putAbiSeq xs = - do putHeads headSize $ toList xs - Vector.sequence_ (putAbiTail <$> xs) - where - headSize = Vector.sum $ Vector.map abiHeadSize xs - putHeads _ [] = pure () - putHeads offset (x:xs') = - case abiKind (abiValueType x) of - Static -> do putAbi x - putHeads offset xs' - Dynamic -> do putAbi (AbiUInt 256 (fromIntegral offset)) - putHeads (offset + abiTailSize x) xs' - -encodeAbiValue :: AbiValue -> BS.ByteString -encodeAbiValue = BSLazy.toStrict . runPut . putAbi - -decodeAbiValue :: AbiType -> BSLazy.ByteString -> AbiValue -decodeAbiValue = runGet . getAbi - -selector :: Text -> BS.ByteString -selector s = BSLazy.toStrict . runPut $ putWord32be (abiKeccak (encodeUtf8 s)) - -abiMethod :: Text -> AbiValue -> BS.ByteString -abiMethod s args = BSLazy.toStrict . runPut $ do - putWord32be (abiKeccak (encodeUtf8 s)) - putAbi args - -parseTypeName :: Vector AbiType -> Text -> Maybe AbiType -parseTypeName = P.parseMaybe . typeWithArraySuffix - -typeWithArraySuffix :: Vector AbiType -> P.Parsec () Text AbiType -typeWithArraySuffix v = do - base <- basicType v - sizes <- - P.many $ - P.between - (P.char '[') (P.char ']') - (P.many P.digitChar) - - let - parseSize :: AbiType -> String -> AbiType - parseSize t "" = AbiArrayDynamicType t - parseSize t s = AbiArrayType (read s) t - - pure (foldl parseSize base sizes) - -basicType :: Vector AbiType -> P.Parsec () Text AbiType -basicType v = - P.choice - [ P.string "address" $> AbiAddressType - , P.string "bool" $> AbiBoolType - , P.string "string" $> AbiStringType - - , sizedType "uint" AbiUIntType - , sizedType "int" AbiIntType - , sizedType "bytes" AbiBytesType - - , P.string "bytes" $> AbiBytesDynamicType - , P.string "tuple" $> AbiTupleType v - ] - - where - sizedType :: Text -> (Int -> AbiType) -> P.Parsec () Text AbiType - sizedType s f = P.try $ do - void (P.string s) - fmap (f . read) (P.some P.digitChar) - -pack32 :: Int -> [Word32] -> Word256 -pack32 n xs = - sum [ shiftL x ((n - i) * 32) - | (x, i) <- zip (map fromIntegral xs) [1..] ] - -asUInt :: Integral i => Int -> (i -> a) -> Get a -asUInt n f = (\(AbiUInt _ x) -> f (fromIntegral x)) <$> getAbi (AbiUIntType n) - -getWord256 :: Get Word256 -getWord256 = pack32 8 <$> replicateM 8 getWord32be - -roundTo32Bytes :: Integral a => a -> a -roundTo32Bytes n = 32 * div (n + 31) 32 - -emptyAbi :: AbiValue -emptyAbi = AbiTuple mempty - -getBytesWith256BitPadding :: Integral a => a -> Get ByteString -getBytesWith256BitPadding i = - (BS.pack <$> replicateM n getWord8) - <* skip ((roundTo32Bytes n) - n) - where n = fromIntegral i - --- QuickCheck instances - -genAbiValue :: AbiType -> Gen AbiValue -genAbiValue = \case - AbiUIntType n -> genUInt n - AbiIntType n -> - do a <- genUInt n - let AbiUInt _ x = a - pure $ AbiInt n (signedWord (x - 2^(n-1))) - AbiAddressType -> - (\(AbiUInt _ x) -> AbiAddress (fromIntegral x)) <$> genUInt 20 - AbiBoolType -> - elements [AbiBool False, AbiBool True] - AbiBytesType n -> - do xs <- replicateM n arbitrary - pure (AbiBytes n (BS.pack xs)) - AbiBytesDynamicType -> - AbiBytesDynamic . BS.pack <$> listOf arbitrary - AbiStringType -> - AbiString . BS.pack <$> listOf arbitrary - AbiArrayDynamicType t -> - do xs <- listOf1 (scale (`div` 2) (genAbiValue t)) - pure (AbiArrayDynamic t (Vector.fromList xs)) - AbiArrayType n t -> - AbiArray n t . Vector.fromList <$> - replicateM n (scale (`div` 2) (genAbiValue t)) - AbiTupleType ts -> - AbiTuple <$> mapM genAbiValue ts - where - genUInt n = AbiUInt n <$> arbitraryIntegralWithMax (2^n-1) - -instance Arbitrary AbiType where - arbitrary = oneof $ -- doesn't create any tuples - [ (AbiUIntType . (* 8)) <$> choose (1, 32) - , (AbiIntType . (* 8)) <$> choose (1, 32) - , pure AbiAddressType - , pure AbiBoolType - , AbiBytesType <$> choose (1,32) - , pure AbiBytesDynamicType - , pure AbiStringType - , AbiArrayDynamicType <$> scale (`div` 2) arbitrary - , AbiArrayType - <$> (getPositive <$> arbitrary) - <*> scale (`div` 2) arbitrary - ] - -instance Arbitrary AbiValue where - arbitrary = arbitrary >>= genAbiValue - shrink = \case - AbiArrayDynamic t v -> - Vector.toList v ++ - map (AbiArrayDynamic t . Vector.fromList) - (shrinkList shrink (Vector.toList v)) - AbiBytesDynamic b -> AbiBytesDynamic . BS.pack <$> shrinkList shrinkIntegral (BS.unpack b) - AbiString b -> AbiString . BS.pack <$> shrinkList shrinkIntegral (BS.unpack b) - AbiBytes n a | n <= 32 -> shrink $ AbiUInt (n * 8) (word256 a) - --bytesN for N > 32 don't really exist right now anyway.. - AbiBytes _ _ | otherwise -> [] - AbiArray _ t v -> - Vector.toList v ++ - map (\x -> AbiArray (length x) t (Vector.fromList x)) - (shrinkList shrink (Vector.toList v)) - AbiTuple v -> Vector.toList $ AbiTuple . Vector.fromList . shrink <$> v - AbiUInt n a -> AbiUInt n <$> (shrinkIntegral a) - AbiInt n a -> AbiInt n <$> (shrinkIntegral a) - AbiBool b -> AbiBool <$> shrink b - AbiAddress a -> [AbiAddress 0xacab, AbiAddress 0xdeadbeef, AbiAddress 0xbabeface] - <> (AbiAddress <$> shrinkIntegral a) - - --- Bool synonym with custom read instance --- to be able to parse lower case 'false' and 'true' -data Boolz = Boolz Bool - -instance Read Boolz where - readsPrec _ ('T':'r':'u':'e':x) = [(Boolz True, x)] - readsPrec _ ('t':'r':'u':'e':x) = [(Boolz True, x)] - readsPrec _ ('f':'a':'l':'s':'e':x) = [(Boolz False, x)] - readsPrec _ ('F':'a':'l':'s':'e':x) = [(Boolz False, x)] - readsPrec _ [] = [] - readsPrec n (_:t) = readsPrec n t - -makeAbiValue :: AbiType -> String -> AbiValue -makeAbiValue typ str = case readP_to_S (parseAbiValue typ) (padStr str) of - [(val,"")] -> val - _ -> error $ "could not parse abi argument: " ++ str ++ " : " ++ show typ - where - padStr = case typ of - (AbiBytesType n) -> padRight' (2 * n + 2) -- +2 is for the 0x prefix - _ -> id - -parseAbiValue :: AbiType -> ReadP AbiValue -parseAbiValue (AbiUIntType n) = do W256 w <- readS_to_P reads - return $ AbiUInt n w -parseAbiValue (AbiIntType n) = do W256 w <- readS_to_P reads - return $ AbiInt n (num w) -parseAbiValue AbiAddressType = AbiAddress <$> readS_to_P reads -parseAbiValue AbiBoolType = (do W256 w <- readS_to_P reads - return $ AbiBool (w /= 0)) - <|> (do Boolz b <- readS_to_P reads - return $ AbiBool b) -parseAbiValue (AbiBytesType n) = AbiBytes n <$> do ByteStringS bytes <- bytesP - return bytes -parseAbiValue AbiBytesDynamicType = AbiBytesDynamic <$> do ByteStringS bytes <- bytesP - return bytes -parseAbiValue AbiStringType = AbiString <$> do Char8.pack <$> readS_to_P reads -parseAbiValue (AbiArrayDynamicType typ) = - AbiArrayDynamic typ <$> do a <- listP (parseAbiValue typ) - return $ Vector.fromList a -parseAbiValue (AbiArrayType n typ) = - AbiArray n typ <$> do a <- listP (parseAbiValue typ) - return $ Vector.fromList a -parseAbiValue (AbiTupleType _) = error "tuple types not supported" - -listP :: ReadP a -> ReadP [a] -listP parser = between (char '[') (char ']') ((do skipSpaces - a <- parser - skipSpaces - return a) `sepBy` (char ',')) - -bytesP :: ReadP ByteStringS -bytesP = do - string "0x" - hex <- munch isHexDigit - case BS16.decode (encodeUtf8 (Text.pack hex)) of - Right d -> pure $ ByteStringS d - Left d -> pfail - -data AbiVals = NoVals | CAbi [AbiValue] | SAbi [SymWord] - deriving (Show) - -decodeBuffer :: [AbiType] -> Buffer -> AbiVals -decodeBuffer tps (ConcreteBuffer b) - = case runGetOrFail (getAbiSeq (length tps) tps) (BSLazy.fromStrict b) of - Right ("", _, args) -> CAbi . toList $ args - _ -> NoVals -decodeBuffer tps b@(SymbolicBuffer _) - = if containsDynamic tps - then NoVals - else SAbi . decodeStaticArgs $ b - where - isDynamic t = abiKind t == Dynamic - containsDynamic = or . fmap isDynamic - -decodeStaticArgs :: Buffer -> [SymWord] -decodeStaticArgs buffer = let - bs = case buffer of - ConcreteBuffer b -> litBytes b - SymbolicBuffer b -> b - in fmap (\i -> S (FromBytes buffer) $ - fromBytes $ take 32 (drop (i*32) bs)) [0..((length bs) `div` 32 - 1)] - --- A modification of 'arbitrarySizedBoundedIntegral' quickcheck library --- which takes the maxbound explicitly rather than relying on a Bounded instance. --- Essentially a mix between three types of generators: --- one that strongly prefers values close to 0, one that prefers values close to max --- and one that chooses uniformly. -arbitraryIntegralWithMax :: (Integral a) => Integer -> Gen a -arbitraryIntegralWithMax maxbound = - sized $ \s -> - do let mn = 0 :: Int - mx = maxbound - bits n | n `quot` 2 == 0 = 0 - | otherwise = 1 + bits (n `quot` 2) - k = 2^(s*(bits mn `max` bits mx `max` 40) `div` 100) - smol <- choose (toInteger mn `max` (-k), toInteger mx `min` k) - mid <- choose (0, maxbound) - elements [fromIntegral smol, fromIntegral mid, fromIntegral (maxbound - (fromIntegral smol))] diff --git a/src/hevm/src/EVM/Concrete.hs b/src/hevm/src/EVM/Concrete.hs deleted file mode 100644 index 92855dff3..000000000 --- a/src/hevm/src/EVM/Concrete.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# Language FlexibleInstances #-} -{-# Language StrictData #-} - -module EVM.Concrete where - -import Prelude hiding (Word) - -import EVM.RLP -import EVM.Types - -import Control.Lens ((^?), ix) -import Data.Bits (Bits (..), shiftL, shiftR) -import Data.ByteString (ByteString) -import Data.Maybe (fromMaybe) -import Data.Word (Word8) - -import qualified Data.ByteString as BS - -wordAt :: Int -> ByteString -> W256 -wordAt i bs = - word (padRight 32 (BS.drop i bs)) - -readByteOrZero :: Int -> ByteString -> Word8 -readByteOrZero i bs = fromMaybe 0 (bs ^? ix i) - -byteStringSliceWithDefaultZeroes :: Int -> Int -> ByteString -> ByteString -byteStringSliceWithDefaultZeroes offset size bs = - if size == 0 - then "" - -- else if offset > BS.length bs - -- then BS.replicate size 0 - -- todo: this ^^ should work, investigate why it causes more GST fails - else - let bs' = BS.take size (BS.drop offset bs) - in bs' <> BS.replicate (size - BS.length bs') 0 - - -wordValue :: Word -> W256 -wordValue (C _ x) = x - -sliceMemory :: (Integral a, Integral b) => a -> b -> ByteString -> ByteString -sliceMemory o s = - byteStringSliceWithDefaultZeroes (num o) (num s) - -writeMemory :: ByteString -> Word -> Word -> Word -> ByteString -> ByteString -writeMemory bs1 (C _ n) (C _ src) (C _ dst) bs0 = - let - (a, b) = BS.splitAt (num dst) bs0 - a' = BS.replicate (num dst - BS.length a) 0 - -- sliceMemory should work for both cases, but we are using 256 bit - -- words, whereas ByteString is only defined up to 64 bit. For large n, - -- src, dst this will cause problems (often in GeneralStateTests). - -- Later we could reimplement ByteString for 256 bit arguments. - c = if src > num (BS.length bs1) - then BS.replicate (num n) 0 - else sliceMemory src n bs1 - b' = BS.drop (num n) b - in - a <> a' <> c <> b' - -readMemoryWord :: Word -> ByteString -> Word -readMemoryWord (C _ i) m = - if i > (num $ BS.length m) then 0 else - let - go !a (-1) = a - go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m) - (8 * (31 - n))) (n - 1) - w = go (0 :: W256) (31 :: Int) - in {-# SCC "readMemoryWord" #-} - C (Literal w) w - -readMemoryWord32 :: Word -> ByteString -> Word -readMemoryWord32 (C _ i) m = - let - go !a (-1) = a - go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m) - (8 * (3 - n))) (n - 1) - in {-# SCC "readMemoryWord32" #-} - w256 $ go (0 :: W256) (3 :: Int) - -setMemoryWord :: Word -> Word -> ByteString -> ByteString -setMemoryWord (C _ i) (C _ x) = - writeMemory (word256Bytes x) 32 0 (num i) - -setMemoryByte :: Word -> Word8 -> ByteString -> ByteString -setMemoryByte (C _ i) x = - writeMemory (BS.singleton x) 1 0 (num i) - -keccakBlob :: ByteString -> Word -keccakBlob x = C (FromKeccak (ConcreteBuffer x)) (keccak x) - --- Copied from the standard library just to get specialization. --- We also use bit operations instead of modulo and multiply. --- (This operation was significantly slow.) -(^) :: W256 -> W256 -> W256 -x0 ^ y0 | y0 < 0 = errorWithoutStackTrace "Negative exponent" - | y0 == 0 = 1 - | otherwise = f x0 y0 - where - f x y | not (testBit y 0) = f (x * x) (y `shiftR` 1) - | y == 1 = x - | otherwise = g (x * x) ((y - 1) `shiftR` 1) x - g x y z | not (testBit y 0) = g (x * x) (y `shiftR` 1) z - | y == 1 = x * z - | otherwise = g (x * x) ((y - 1) `shiftR` 1) (x * z) - -createAddress :: Addr -> W256 -> Addr -createAddress a n = num $ keccak $ rlpList [rlpAddrFull a, rlpWord256 n] - -create2Address :: Addr -> W256 -> ByteString -> Addr -create2Address a s b = num $ keccak $ mconcat - [BS.singleton 0xff, word160Bytes a, word256Bytes $ num s, word256Bytes $ keccak b] diff --git a/src/hevm/src/EVM/Dapp.hs b/src/hevm/src/EVM/Dapp.hs deleted file mode 100644 index ffa78e3ae..000000000 --- a/src/hevm/src/EVM/Dapp.hs +++ /dev/null @@ -1,199 +0,0 @@ -{-# Language TemplateHaskell #-} -{-# Language OverloadedStrings #-} - -module EVM.Dapp where - -import EVM (Trace, traceContract, traceOpIx, ContractCode(..), Contract(..), codehash, contractcode) -import EVM.ABI (Event, AbiType, SolError) -import EVM.Debug (srcMapCodePos) -import EVM.Solidity -import EVM.Types (W256, abiKeccak, keccak, Buffer(..), Addr, regexMatches) -import EVM.Concrete - -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Aeson (Value) -import Data.Bifunctor (first) -import Data.Text (Text, isPrefixOf, pack, unpack) -import Data.Text.Encoding (encodeUtf8) -import Data.Map (Map, toList, elems) -import Data.List (sort) -import Data.Maybe (isJust, fromJust) -import Data.Word (Word32) - -import Control.Arrow ((>>>)) -import Control.Lens - -import Data.List (find) -import qualified Data.Map as Map - -data DappInfo = DappInfo - { _dappRoot :: FilePath - , _dappSolcByName :: Map Text SolcContract - , _dappSolcByHash :: Map W256 (CodeType, SolcContract) - , _dappSolcByCode :: [(Code, SolcContract)] -- for contracts with `immutable` vars. - , _dappSources :: SourceCache - , _dappUnitTests :: [(Text, [(Test, [AbiType])])] - , _dappAbiMap :: Map Word32 Method - , _dappEventMap :: Map W256 Event - , _dappErrorMap :: Map W256 SolError - , _dappAstIdMap :: Map Int Value - , _dappAstSrcMap :: SrcMap -> Maybe Value - } - --- | bytecode modulo immutables, to identify contracts -data Code = - Code { - raw :: ByteString, - immutableLocations :: [Reference] - } - deriving Show - -data DappContext = DappContext - { _contextInfo :: DappInfo - , _contextEnv :: Map Addr Contract - } - -data Test = ConcreteTest Text | SymbolicTest Text | InvariantTest Text - -makeLenses ''DappInfo -makeLenses ''DappContext - -instance Show Test where - show t = unpack $ extractSig t - -dappInfo - :: FilePath -> Map Text SolcContract -> SourceCache -> DappInfo -dappInfo root solcByName sources = - let - solcs = Map.elems solcByName - astIds = astIdMap $ snd <$> toList (view sourceAsts sources) - immutables = filter ((/=) mempty . _immutableReferences) solcs - - in DappInfo - { _dappRoot = root - , _dappUnitTests = findAllUnitTests solcs - , _dappSources = sources - , _dappSolcByName = solcByName - , _dappSolcByHash = - let - f g k = Map.fromList [(view g x, (k, x)) | x <- solcs] - in - mappend - (f runtimeCodehash Runtime) - (f creationCodehash Creation) - -- contracts with immutable locations can't be id by hash - , _dappSolcByCode = - [(Code (_runtimeCode x) (concat $ elems $ _immutableReferences x), x) | x <- immutables] - -- Sum up the ABI maps from all the contracts. - , _dappAbiMap = mconcat (map (view abiMap) solcs) - , _dappEventMap = mconcat (map (view eventMap) solcs) - , _dappErrorMap = mconcat (map (view errorMap) solcs) - - , _dappAstIdMap = astIds - , _dappAstSrcMap = astSrcMap astIds - } - -emptyDapp :: DappInfo -emptyDapp = dappInfo "" mempty (SourceCache mempty mempty mempty) - --- Dapp unit tests are detected by searching within abi methods --- that begin with "test" or "prove", that are in a contract with --- the "IS_TEST()" abi marker, for a given regular expression. --- --- The regex is matched on the full test method name, including path --- and contract, i.e. "path/to/file.sol:TestContract.test_name()". --- --- Tests beginning with "test" are interpreted as concrete tests, whereas --- tests beginning with "prove" are interpreted as symbolic tests. - -unitTestMarkerAbi :: Word32 -unitTestMarkerAbi = abiKeccak (encodeUtf8 "IS_TEST()") - -findAllUnitTests :: [SolcContract] -> [(Text, [(Test, [AbiType])])] -findAllUnitTests = findUnitTests ".*:.*\\.(test|prove|invariant).*" - -mkTest :: Text -> Maybe Test -mkTest sig - | "test" `isPrefixOf` sig = Just (ConcreteTest sig) - | "prove" `isPrefixOf` sig = Just (SymbolicTest sig) - | "invariant" `isPrefixOf` sig = Just (InvariantTest sig) - | otherwise = Nothing - -findUnitTests :: Text -> ([SolcContract] -> [(Text, [(Test, [AbiType])])]) -findUnitTests match = - concatMap $ \c -> - case preview (abiMap . ix unitTestMarkerAbi) c of - Nothing -> [] - Just _ -> - let testNames = unitTestMethodsFiltered (regexMatches match) c - in [(view contractName c, testNames) | not (BS.null (view runtimeCode c)) && not (null testNames)] - -unitTestMethodsFiltered :: (Text -> Bool) -> (SolcContract -> [(Test, [AbiType])]) -unitTestMethodsFiltered matcher c = - let - testName method = (view contractName c) <> "." <> (extractSig (fst method)) - in - filter (matcher . testName) (unitTestMethods c) - -unitTestMethods :: SolcContract -> [(Test, [AbiType])] -unitTestMethods = - view abiMap - >>> Map.elems - >>> map (\f -> (mkTest $ view methodSignature f, snd <$> view methodInputs f)) - >>> filter (isJust . fst) - >>> fmap (first fromJust) - -extractSig :: Test -> Text -extractSig (ConcreteTest sig) = sig -extractSig (SymbolicTest sig) = sig -extractSig (InvariantTest sig) = sig - -traceSrcMap :: DappInfo -> Trace -> Maybe SrcMap -traceSrcMap dapp trace = - let - h = view traceContract trace - i = view traceOpIx trace - in srcMap dapp h i - -srcMap :: DappInfo -> Contract -> Int -> Maybe SrcMap -srcMap dapp contr opIndex = do - sol <- findSrc contr dapp - case view contractcode contr of - (InitCode _) -> - preview (creationSrcmap . ix opIndex) sol - (RuntimeCode _) -> - preview (runtimeSrcmap . ix opIndex) sol - -findSrc :: Contract -> DappInfo -> Maybe SolcContract -findSrc c dapp = case preview (dappSolcByHash . ix (view codehash c)) dapp of - Just (_, v) -> Just v - Nothing -> lookupCode (view contractcode c) dapp - - -lookupCode :: ContractCode -> DappInfo -> Maybe SolcContract -lookupCode (InitCode (SymbolicBuffer _)) _ = Nothing -- TODO: srcmaps for symbolic bytecode -lookupCode (RuntimeCode (SymbolicBuffer _)) _ = Nothing -- TODO: srcmaps for symbolic bytecode -lookupCode (InitCode (ConcreteBuffer c)) a = - snd <$> preview (dappSolcByHash . ix (keccak (stripBytecodeMetadata c))) a -lookupCode (RuntimeCode (ConcreteBuffer c)) a = - case snd <$> preview (dappSolcByHash . ix (keccak (stripBytecodeMetadata c))) a of - Just x -> return x - Nothing -> snd <$> find (compareCode c . fst) (view dappSolcByCode a) - -compareCode :: ByteString -> Code -> Bool -compareCode raw (Code template locs) = - let holes' = sort [(start, len) | (Reference start len) <- locs] - insert at' len' bs = writeMemory (BS.replicate len' 0) (fromIntegral len') 0 (fromIntegral at') bs - refined = foldr (\(start, len) acc -> insert start len acc) raw holes' - in BS.length raw == BS.length template && template == refined - -showTraceLocation :: DappInfo -> Trace -> Either Text Text -showTraceLocation dapp trace = - case traceSrcMap dapp trace of - Nothing -> Left "" - Just sm -> - case srcMapCodePos (view dappSources dapp) sm of - Nothing -> Left "" - Just (fileName, lineIx) -> - Right (fileName <> ":" <> pack (show lineIx)) diff --git a/src/hevm/src/EVM/Debug.hs b/src/hevm/src/EVM/Debug.hs deleted file mode 100644 index 4e53abda3..000000000 --- a/src/hevm/src/EVM/Debug.hs +++ /dev/null @@ -1,115 +0,0 @@ -module EVM.Debug where - -import EVM (Contract, storage, nonce, balance, bytecode, codehash) -import EVM.Solidity (SrcMap, srcMapFile, srcMapOffset, srcMapLength, SourceCache, sourceFiles) -import EVM.Types (Addr) -import EVM.Symbolic (len) - -import Control.Arrow (second) -import Control.Lens -import Data.ByteString (ByteString) -import Data.Map (Map) -import Data.Text (Text) - -import qualified Data.ByteString as ByteString -import qualified Data.Map as Map - -import Text.PrettyPrint.ANSI.Leijen - -data Mode = Debug | Run | JsonTrace deriving (Eq, Show) - -object :: [(Doc, Doc)] -> Doc -object xs = - group $ lbrace - <> line - <> indent 2 (sep (punctuate (char ';') [k <+> equals <+> v | (k, v) <- xs])) - <> line - <> rbrace - -prettyContract :: Contract -> Doc -prettyContract c = - object - [ (text "codesize", int (len (c ^. bytecode))) - , (text "codehash", text (show (c ^. codehash))) - , (text "balance", int (fromIntegral (c ^. balance))) - , (text "nonce", int (fromIntegral (c ^. nonce))) - , (text "storage", text (show (c ^. storage))) - ] - -prettyContracts :: Map Addr Contract -> Doc -prettyContracts x = - object - (map (\(a, b) -> (text (show a), prettyContract b)) - (Map.toList x)) - --- debugger :: Maybe SourceCache -> VM -> IO VM --- debugger maybeCache vm = do --- -- cpprint (view state vm) --- cpprint ("pc" :: Text, view (state . pc) vm) --- cpprint (view (state . stack) vm) --- -- cpprint (view logs vm) --- cpprint (vmOp vm) --- cpprint (opParams vm) --- cpprint (length (view frames vm)) - --- -- putDoc (prettyContracts (view (env . contracts) vm)) - --- case maybeCache of --- Nothing -> --- return () --- Just cache -> --- case currentSrcMap vm of --- Nothing -> cpprint ("no srcmap" :: Text) --- Just sm -> cpprint (srcMapCode cache sm) - --- if vm ^. result /= Nothing --- then do --- print (vm ^. result) --- return vm --- else --- -- readline "(evm) " >>= --- return (Just "") >>= --- \case --- Nothing -> --- return vm --- Just cmdline -> --- case words cmdline of --- [] -> --- debugger maybeCache (execState exec1 vm) - --- ["block"] -> --- do cpprint (view block vm) --- debugger maybeCache vm - --- ["storage"] -> --- do cpprint (view (env . contracts) vm) --- debugger maybeCache vm - --- ["contracts"] -> --- do putDoc (prettyContracts (view (env . contracts) vm)) --- debugger maybeCache vm - --- -- ["disassemble"] -> --- -- do cpprint (mkCodeOps (view (state . code) vm)) --- -- debugger maybeCache vm - --- _ -> debugger maybeCache vm - --- lookupSolc :: VM -> W256 -> Maybe SolcContract --- lookupSolc vm hash = --- case vm ^? env . solcByRuntimeHash . ix hash of --- Just x -> Just x --- Nothing -> --- vm ^? env . solcByCreationHash . ix hash - -srcMapCodePos :: SourceCache -> SrcMap -> Maybe (Text, Int) -srcMapCodePos cache sm = - fmap (second f) $ cache ^? sourceFiles . ix (srcMapFile sm) - where - f v = ByteString.count 0xa (ByteString.take (srcMapOffset sm - 1) v) + 1 - -srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString -srcMapCode cache sm = - fmap f $ cache ^? sourceFiles . ix (srcMapFile sm) - where - f (_, v) = ByteString.take (min 80 (srcMapLength sm)) (ByteString.drop (srcMapOffset sm) v) diff --git a/src/hevm/src/EVM/Demand.hs b/src/hevm/src/EVM/Demand.hs deleted file mode 100644 index 3a876d174..000000000 --- a/src/hevm/src/EVM/Demand.hs +++ /dev/null @@ -1,13 +0,0 @@ -module EVM.Demand (demand) where - -import Control.DeepSeq (NFData, force) -import Control.Exception.Base (evaluate) -import Control.Monad.IO.Class (MonadIO, liftIO) - --- | This is an easy way to force full evaluation of a value inside of --- the IO monad, being essentially just the composition of @evaluate@ --- and @force@. -demand :: (MonadIO m, NFData a) => a -> m () -demand x = do - _ <- liftIO (evaluate (force x)) - return () diff --git a/src/hevm/src/EVM/Dev.hs b/src/hevm/src/EVM/Dev.hs deleted file mode 100644 index 2f3f2640b..000000000 --- a/src/hevm/src/EVM/Dev.hs +++ /dev/null @@ -1,263 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -module EVM.Dev where - -import System.Directory - -import Prelude hiding (Word) - -import EVM.Types -import EVM.Dapp -import EVM.Solidity -import EVM.UnitTest -import EVM.Symbolic - -import EVM hiding (path) -import qualified EVM.Fetch -import qualified EVM.TTY -import qualified EVM.Emacs -import qualified EVM.Facts as Facts -import qualified EVM.Facts.Git as Git -import qualified EVM.Stepper -import qualified EVM.VMTest as VMTest - -import Data.SBV hiding (Word) -import qualified Data.Aeson as JSON -import Options.Generic -import Data.SBV.Trans.Control -import Data.Maybe (fromMaybe) -import Control.Monad.State.Strict (execStateT) - -import qualified Data.Map as Map -import qualified Data.ByteString.Lazy as LazyByteString -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy.Char8 as B -import qualified Control.Monad.State.Class as State -import Control.Monad.State.Strict (runState, liftIO, StateT, get) -import Control.Lens hiding (op, passing) -import Control.Monad.Operational (ProgramViewT(..), ProgramView) -import qualified Control.Monad.Operational as Operational - -loadDappInfo :: String -> String -> IO DappInfo -loadDappInfo path file = - withCurrentDirectory path $ - readSolc file >>= - \case - Just (contractMap, sourcecache) -> - pure (dappInfo "." contractMap sourcecache) - _ -> - error "nope, sorry" - -ghciTest :: String -> String -> Maybe String -> IO [Bool] -ghciTest root path statePath = - withCurrentDirectory root $ do - loadFacts <- - case statePath of - Nothing -> - pure id - Just repoPath -> do - facts <- Git.loadFacts (Git.RepoAt repoPath) - pure (flip Facts.apply facts) - params <- getParametersFromEnvironmentVariables Nothing - dapp <- loadDappInfo root path - let - opts = UnitTestOptions - { oracle = EVM.Fetch.zero - , verbose = Nothing - , maxIter = Nothing - , askSmtIters = Nothing - , smtTimeout = Nothing - , smtState = Nothing - , solver = Nothing - , match = "" - , covMatch = Nothing - , fuzzRuns = 100 - , replay = Nothing - , vmModifier = loadFacts - , dapp = dapp - , testParams = params - , maxDepth = Nothing - , ffiAllowed = False - } - readSolc path >>= - \case - Just (contractMap, _) -> do - let unitTests = findAllUnitTests (Map.elems contractMap) - results <- runSMT $ query $ concatMapM (runUnitTestContract opts contractMap) unitTests - let (passing, _) = unzip results - pure passing - - Nothing -> - error ("Failed to read Solidity JSON for `" ++ path ++ "'") - -runBCTest :: (String, VMTest.Case) -> IO Bool -runBCTest (name, x) = do - let vm0 = VMTest.vmForCase x - putStr (name ++ " ") - out <- - execStateT (EVM.Stepper.interpret EVM.Fetch.zero EVM.Stepper.execFully) vm0 - ok <- VMTest.checkExpectation False x out - putStrLn (if ok then "ok" else "") - return ok - -ghciBCTest :: String -> IO () -ghciBCTest file = do - let parser = VMTest.parseBCSuite - parsed <- parser <$> LazyByteString.readFile file - case parsed of - Left "No cases to check." -> putStrLn "no-cases ok" - Left err -> print err - Right allTests -> - mapM_ runBCTest (Map.toList allTests) - -ghciTty :: String -> String -> Maybe String -> IO () -ghciTty root path statePath = - withCurrentDirectory root $ do - loadFacts <- - case statePath of - Nothing -> - pure id - Just repoPath -> do - facts <- Git.loadFacts (Git.RepoAt repoPath) - pure (flip Facts.apply facts) - params <- getParametersFromEnvironmentVariables Nothing - let - testOpts = UnitTestOptions - { oracle = EVM.Fetch.zero - , verbose = Nothing - , maxIter = Nothing - , askSmtIters = Nothing - , smtTimeout = Nothing - , smtState = Nothing - , solver = Nothing - , match = "" - , covMatch = Nothing - , fuzzRuns = 100 - , replay = Nothing - , vmModifier = loadFacts - , dapp = emptyDapp - , testParams = params - , maxDepth = Nothing - , ffiAllowed = False - } - EVM.TTY.main testOpts root path - -ghciEmacs :: IO () -ghciEmacs = - EVM.Emacs.main - -foo :: IO () -foo = ghciEmacs - -data VMTrace = - VMTrace - { pc :: Int - , op :: Int - , stack :: [Word] - , memSize :: Int - , depth :: Int - , gas :: Word - } deriving (Generic, JSON.ToJSON) - -data VMTraceResult = - VMTraceResult - { output :: String - , gasUsed :: Word - } deriving (Generic, JSON.ToJSON) - -getOp :: VM -> Word8 -getOp vm = - let i = vm ^. state . EVM.pc - code' = vm ^. state . code - xs = case code' of - ConcreteBuffer xs' -> ConcreteBuffer (BS.drop i xs') - SymbolicBuffer xs' -> SymbolicBuffer (drop i xs') - in if len xs == 0 then 0 - else case xs of - ConcreteBuffer b -> BS.index b 0 - SymbolicBuffer b -> fromSized $ fromMaybe (error "unexpected symbolic code") (unliteral (b !! 0)) - -vmtrace :: VM -> VMTrace -vmtrace vm = - let - -- Convenience function to access parts of the current VM state. - -- Arcane type signature needed to avoid monomorphism restriction. - the :: (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a - the f g = view (f . g) vm - memsize = the state memorySize - in VMTrace { pc = the state EVM.pc - , op = num $ getOp vm - , gas = the state EVM.gas - , memSize = memsize - -- increment to match geth format - , depth = 1 + length (view frames vm) - -- reverse to match geth format - , stack = reverse $ forceLit <$> the state EVM.stack - } - -vmres :: VM -> VMTraceResult -vmres vm = - let - gasUsed' = view (tx . txgaslimit) vm - view (state . EVM.gas) vm - res = case view result vm of - Just (VMSuccess out) -> forceBuffer out - Just (VMFailure (Revert out)) -> out - _ -> mempty - in VMTraceResult - -- more oddities to comply with geth - { output = drop 2 $ show $ ByteStringS res - , gasUsed = gasUsed' - } - -interpretWithTrace :: EVM.Fetch.Fetcher -> EVM.Stepper.Stepper a -> StateT VM IO a -interpretWithTrace fetcher = - eval . Operational.view - - where - eval - :: ProgramView EVM.Stepper.Action a - -> StateT VM IO a - - eval (Return x) = do - vm <- get - liftIO $ B.putStrLn $ JSON.encode $ vmres vm - pure x - - eval (action :>>= k) = do - vm <- get - case action of - EVM.Stepper.Run -> do - -- Have we reached the final result of this action? - use result >>= \case - Just _ -> do - -- Yes, proceed with the next action. - interpretWithTrace fetcher (k vm) - Nothing -> do - liftIO $ B.putStrLn $ JSON.encode $ vmtrace vm - - -- No, keep performing the current action - State.state (runState exec1) - interpretWithTrace fetcher (EVM.Stepper.run >>= k) - - -- Stepper wants to keep executing? - EVM.Stepper.Exec -> do - -- Have we reached the final result of this action? - use result >>= \case - Just r -> do - -- Yes, proceed with the next action. - interpretWithTrace fetcher (k r) - Nothing -> do - liftIO $ B.putStrLn $ JSON.encode $ vmtrace vm - - -- No, keep performing the current action - State.state (runState exec1) - interpretWithTrace fetcher (EVM.Stepper.exec >>= k) - EVM.Stepper.Wait q -> - do m <- liftIO (fetcher q) - State.state (runState m) >> interpretWithTrace fetcher (k ()) - EVM.Stepper.Ask _ -> - error "cannot make choices with this interpretWithTraceer" - EVM.Stepper.IOAct m -> - m >>= interpretWithTrace fetcher . k - EVM.Stepper.EVM m -> do - r <- State.state (runState m) - interpretWithTrace fetcher (k r) diff --git a/src/hevm/src/EVM/Emacs.hs b/src/hevm/src/EVM/Emacs.hs deleted file mode 100644 index ed5ca99c6..000000000 --- a/src/hevm/src/EVM/Emacs.hs +++ /dev/null @@ -1,555 +0,0 @@ -{-# Language ImplicitParams #-} -{-# Language TemplateHaskell #-} -{-# Language DataKinds #-} -{-# Language FlexibleInstances #-} - -module EVM.Emacs where - -import Control.Lens -import Control.Monad.IO.Class -import Control.Monad.State.Strict hiding (state) -import Data.ByteString (ByteString) -import Data.Map (Map) -import Data.Maybe -import Data.Monoid -import Data.SCargot -import Data.SCargot.Language.HaskLike -import Data.SCargot.Repr -import Data.SCargot.Repr.Basic -import Data.Set (Set) -import Data.Text (Text, pack, unpack) -import Data.SBV hiding (Word, output) -import EVM -import EVM.ABI -import EVM.Symbolic -import EVM.Dapp -import EVM.Debug (srcMapCodePos) -import EVM.Fetch (Fetcher) -import EVM.Solidity -import EVM.Stepper (Stepper) -import EVM.TTY (currentSrcMap) -import EVM.Types -import EVM.UnitTest -import Prelude hiding (Word) -import System.Directory -import System.IO -import qualified Control.Monad.Operational as Operational -import qualified Data.List as List -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified EVM.Fetch as Fetch -import qualified EVM.Stepper as Stepper - -data UiVmState = UiVmState - { _uiVm :: VM - , _uiVmNextStep :: Stepper () - , _uiVmSolc :: Maybe SolcContract - , _uiVmDapp :: Maybe DappInfo - , _uiVmStepCount :: Int - , _uiVmFirstState :: UiVmState - , _uiVmFetcher :: Fetcher - , _uiVmMessage :: Maybe Text - , _uiVmSentHashes :: Set W256 - } - -makeLenses ''UiVmState - -type Pred a = a -> Bool - -data StepMode - = StepOne -- ^ Finish after one opcode step - | StepMany !Int -- ^ Run a specific number of steps - | StepNone -- ^ Finish before the next opcode - | StepUntil (Pred VM) -- ^ Finish when a VM predicate holds - -data StepOutcome a - = Returned a -- ^ Program finished - | Stepped (Stepper a) -- ^ Took one step; more steps to go - | Blocked (IO (Stepper a)) -- ^ Came across blocking request - -interpret - :: StepMode - -> Stepper a - -> State UiVmState (StepOutcome a) -interpret mode = - eval . Operational.view - where - eval - :: Operational.ProgramView Stepper.Action a - -> State UiVmState (StepOutcome a) - - eval (Operational.Return x) = - pure (Returned x) - - eval (action Operational.:>>= k) = - case action of - -- Stepper wants to keep executing? - Stepper.Exec -> do - let - -- When pausing during exec, we should later restart - -- the exec with the same continuation. - restart = Stepper.exec >>= k - - case mode of - StepNone -> - -- We come here when we've continued while stepping, - -- either from a query or from a return; - -- we should pause here and wait for the user. - pure (Stepped (Operational.singleton action >>= k)) - - StepOne -> do - -- Run an instruction - modify stepOneOpcode - - use (uiVm . result) >>= \case - Nothing -> - -- If instructions remain, then pause & await user. - pure (Stepped restart) - Just r -> - -- If returning, proceed directly the continuation, - -- but stopping before the next instruction. - interpret StepNone (k r) - - StepMany 0 -> - -- Finish the continuation until the next instruction; - -- then, pause & await user. - interpret StepNone restart - - StepMany i -> - -- Run one instruction. - interpret StepOne restart >>= - \case - Stepped stepper -> - interpret (StepMany (i - 1)) stepper - - -- This shouldn't happen, because re-stepping needs - -- to avoid blocking and halting. - r -> pure r - - StepUntil p -> do - vm <- use uiVm - case p vm of - True -> - interpret StepNone restart - False -> - interpret StepOne restart >>= - \case - Stepped stepper -> - interpret (StepUntil p) stepper - - -- This means that if we hit a blocking query - -- or a return, we pause despite the predicate. - -- - -- This could be fixed if we allowed query I/O - -- here, instead of only in the TTY event loop; - -- let's do it later. - r -> pure r - - -- Stepper wants to make a query and wait for the results? - Stepper.Wait q -> do - fetcher <- use uiVmFetcher - -- Tell the TTY to run an I/O action to produce the next stepper. - pure . Blocked $ do - -- First run the fetcher, getting a VM state transition back. - m <- fetcher q - -- Join that transition with the stepper script's continuation. - pure (Stepper.evm m >> k ()) - - -- Stepper wants to modify the VM. - Stepper.EVM m -> do - vm0 <- use uiVm - let (r, vm1) = runState m vm0 - modify (flip updateUiVmState vm1) - modify updateSentHashes - interpret mode (k r) - -stepOneOpcode :: UiVmState -> UiVmState -stepOneOpcode ui = - let - nextVm = execState exec1 (view uiVm ui) - in - ui & over uiVmStepCount (+ 1) - & set uiVm nextVm - -updateUiVmState :: UiVmState -> VM -> UiVmState -updateUiVmState ui vm = - ui & set uiVm vm - -updateSentHashes :: UiVmState -> UiVmState -updateSentHashes ui = - let sent = allHashes (view uiVm ui) in - ui & set uiVmSentHashes sent - -type Sexp = WellFormedSExpr HaskLikeAtom - -prompt :: Console (Maybe Sexp) -prompt = do - line <- liftIO (putStr "> " >> hFlush stdout >> getLine) - case decodeOne (asWellFormed haskLikeParser) (pack line) of - Left e -> do - output (L [A "error", A (txt e)]) - pure Nothing - Right s -> - pure (Just s) - -class SDisplay a where - sexp :: a -> SExpr Text - -display :: SDisplay a => a -> Text -display = encodeOne (basicPrint id) . sexp - -txt :: Show a => a -> Text -txt = pack . show - -data UiState - = UiStarted - | UiDappLoaded DappInfo - | UiVm UiVmState - -type Console a = StateT UiState IO a - -output :: SDisplay a => a -> Console () -output = liftIO . putStrLn . unpack . display - -main :: IO () -main = do - putStrLn ";; Welcome to Hevm's Emacs integration." - _ <- execStateT loop UiStarted - pure () - -loop :: Console () -loop = - prompt >>= - \case - Nothing -> pure () - Just command -> do - handle command - loop - -handle :: Sexp -> Console () -handle (WFSList (WFSAtom (HSIdent cmd) : args)) = - do s <- get - handleCmd s (cmd, args) -handle _ = - output (L [A ("unrecognized-command" :: Text)]) - -handleCmd :: UiState -> (Text, [Sexp]) -> Console () -handleCmd UiStarted = \case - ("load-dapp", - [WFSAtom (HSString (unpack -> root)), - WFSAtom (HSString (unpack -> jsonPath))]) -> - do liftIO (setCurrentDirectory root) - liftIO (readSolc jsonPath) >>= - \case - Nothing -> - output (L [A ("error" :: Text)]) - Just (contractMap, sourceCache) -> - let - dapp = dappInfo root contractMap sourceCache - in do - output dapp - put (UiDappLoaded dapp) - - _ -> - output (L [A ("unrecognized-command" :: Text)]) - -handleCmd (UiDappLoaded _) = \case - ("run-test", [WFSAtom (HSString contractPath), - WFSAtom (HSString testName)]) -> do - opts <- defaultUnitTestOptions - put (UiVm (initialStateForTest opts (contractPath, testName))) - outputVm - _ -> - output (L [A ("unrecognized-command" :: Text)]) - -handleCmd (UiVm s) = \case - ("step", [WFSAtom (HSString modeName)]) -> - case parseStepMode s modeName of - Just mode -> do - takeStep s StepNormally mode - outputVm - Nothing -> - output (L [A ("unrecognized-command" :: Text)]) - ("step", [WFSList [ WFSAtom (HSString "file-line") - , WFSAtom (HSString fileName) - , WFSAtom (HSInt (fromIntegral -> lineNumber)) - ]]) -> - case view uiVmDapp s of - Nothing -> - output (L [A ("impossible" :: Text)]) - Just dapp -> do - takeStep s StepNormally - (StepUntil (atFileLine dapp fileName lineNumber)) - outputVm - _ -> - output (L [A ("unrecognized-command" :: Text)]) - -atFileLine :: DappInfo -> Text -> Int -> VM -> Bool -atFileLine dapp wantedFileName wantedLineNumber vm = - case currentSrcMap dapp vm of - Nothing -> False - Just sm -> - let - (currentFileName, currentLineNumber) = - fromJust (srcMapCodePos (view dappSources dapp) sm) - in - currentFileName == wantedFileName && - currentLineNumber == wantedLineNumber - -codeByHash :: W256 -> VM -> Maybe Buffer -codeByHash h vm = do - let cs = view (env . contracts) vm - c <- List.find (\c -> h == (view codehash c)) (Map.elems cs) - return (view bytecode c) - -allHashes :: VM -> Set W256 -allHashes vm = let cs = view (env . contracts) vm - in Set.fromList ((view codehash) <$> Map.elems cs) - -outputVm :: Console () -outputVm = do - UiVm s <- get - let vm = view uiVm s - sendHashes = Set.difference (allHashes vm) (view uiVmSentHashes s) - sendCodes = Map.fromSet (`codeByHash` vm) sendHashes - noMap = - output $ - L [ A "step" - , L [A ("vm" :: Text), sexp (view uiVm s)] - ] - fromMaybe noMap $ do - dapp <- view uiVmDapp s - sm <- currentSrcMap dapp (view uiVm s) - let (fileName, _) = view (dappSources . sourceFiles) dapp !! srcMapFile sm - pure . output $ - L [ A "step" - , L [A ("vm" :: Text), sexp (view uiVm s)] - , L [A ("file" :: Text), A (txt fileName)] - , L [ A ("srcmap" :: Text) - , A (txt (srcMapOffset sm)) - , A (txt (srcMapLength sm)) - , A (txt (srcMapJump sm)) - ] - ] - - -isNextSourcePosition - :: UiVmState -> Pred VM -isNextSourcePosition ui vm = - let - Just dapp = view uiVmDapp ui - initialPosition = currentSrcMap dapp (view uiVm ui) - in - currentSrcMap dapp vm /= initialPosition - -parseStepMode :: UiVmState -> Text -> Maybe StepMode -parseStepMode s = - \case - "once" -> Just StepOne - "source-location" -> Just (StepUntil (isNextSourcePosition s)) - _ -> Nothing - --- ^ Specifies whether to do I/O blocking or VM halting while stepping. --- When we step backwards, we don't want to allow those things. -data StepPolicy - = StepNormally -- ^ Allow blocking and returning - | StepTimidly -- ^ Forbid blocking and returning - -takeStep - :: UiVmState - -> StepPolicy - -> StepMode - -> Console () -takeStep ui policy mode = do - let m = interpret mode (view uiVmNextStep ui) - - case runState m ui of - - (Stepped stepper, ui') -> - put (UiVm (ui' & set uiVmNextStep stepper)) - - (Blocked blocker, ui') -> - case policy of - StepNormally -> do - stepper <- liftIO blocker - takeStep - (execState (assign uiVmNextStep stepper) ui') - StepNormally StepNone - - StepTimidly -> - error "step blocked unexpectedly" - - (Returned (), ui') -> - case policy of - StepNormally -> - put (UiVm ui') - StepTimidly -> - error "step halted unexpectedly" - - -- readSolc jsonPath >>= - -- \case - -- Nothing -> error "Failed to read Solidity JSON" - -- Just (contractMap, sourceCache) -> do - -- let - -- dapp = dappInfo root contractMap sourceCache - -- putStrLn (unpack (display dapp)) - -instance SDisplay DappInfo where - sexp x = - L [ A "dapp-info" - , L [A "root", A (txt $ view dappRoot x)] - , L (A "unit-tests" : - [ L [A (txt a), L (map (A . txt) b)] - | (a, b) <- view dappUnitTests x]) - ] - -instance SDisplay (SExpr Text) where - sexp = id - -instance SDisplay Storage where - sexp (Symbolic _ _) = error "idk" - sexp (Concrete d) = sexp d - -instance SDisplay VM where - sexp x = - L [ L [A "result", sexp (view result x)] - , L [A "state", sexp (view state x)] - , L [A "frames", sexp (view frames x)] - , L [A "contracts", sexp (view (env . contracts) x)] - ] - -quoted :: Text -> Text -quoted x = "\"" <> x <> "\"" - -instance SDisplay Addr where - sexp = A . quoted . pack . show - -instance SDisplay Contract where - sexp x = - L [ L [A "storage", sexp (view storage x)] - , L [A "balance", sexp (view balance x)] - , L [A "nonce", sexp (view nonce x)] - , L [A "codehash", sexp (view codehash x)] - ] - -instance SDisplay W256 where - sexp x = A (txt (txt x)) - --- no idea what's going on here -instance SDisplay (SWord 256) where - sexp x = A (txt (txt x)) - --- no idea what's going on here -instance SDisplay (SymWord) where - sexp x = A (txt (txt x)) - --- no idea what's going on here -instance SDisplay (SWord 8) where - sexp x = A (txt (txt x)) - --- no idea what's going on here -instance SDisplay Buffer where - sexp (SymbolicBuffer x) = sexp x - sexp (ConcreteBuffer x) = sexp x - -instance (SDisplay k, SDisplay v) => SDisplay (Map k v) where - sexp x = L [L [sexp k, sexp v] | (k, v) <- Map.toList x] - -instance SDisplay a => SDisplay (Maybe a) where - sexp Nothing = A "nil" - sexp (Just x) = sexp x - -instance SDisplay VMResult where - sexp = \case - VMFailure e -> L [A "vm-failure", A (txt (txt e))] - VMSuccess b -> L [A "vm-success", sexp b] - -instance SDisplay Frame where - sexp x = - L [A "frame", sexp (view frameContext x), sexp (view frameState x)] - -instance SDisplay FrameContext where - sexp _x = A "some-context" - -instance SDisplay FrameState where - sexp x = - L [ L [A "contract", sexp (view contract x)] - , L [A "code-contract", sexp (view codeContract x)] - , L [A "pc", A (txt (view pc x))] - , L [A "stack", sexp (view stack x)] - , L [A "memory", sexpMemory (view memory x)] - ] - -instance SDisplay a => SDisplay [a] where - sexp = L . map sexp - --- this overlaps the neighbouring [a] instance -instance {-# OVERLAPPING #-} SDisplay String where - sexp x = A (txt x) - -instance SDisplay Word where - sexp (C (FromKeccak bs) x) = - L [A "hash", A (txt x), sexp bs] - sexp (C _ x) = A (quoted (txt x)) - -instance SDisplay ByteString where - sexp = A . txt . pack . show . ByteStringS - -sexpMemory :: Buffer -> SExpr Text -sexpMemory bs = - if len bs > 1024 - then L [A "large-memory", A (txt (len bs))] - else sexp bs - -defaultUnitTestOptions :: MonadIO m => m UnitTestOptions -defaultUnitTestOptions = do - params <- liftIO $ getParametersFromEnvironmentVariables Nothing - pure UnitTestOptions - { oracle = Fetch.zero - , verbose = Nothing - , maxIter = Nothing - , askSmtIters = Nothing - , smtTimeout = Nothing - , smtState = Nothing - , solver = Nothing - , match = "" - , covMatch = Nothing - , fuzzRuns = 100 - , replay = Nothing - , vmModifier = id - , dapp = emptyDapp - , testParams = params - , maxDepth = Nothing - , ffiAllowed = False - } - -initialStateForTest - :: UnitTestOptions - -> (Text, Text) - -> UiVmState -initialStateForTest opts@(UnitTestOptions {..}) (contractPath, testName) = - ui1 - where - script = do - Stepper.evm . pushTrace . EntryTrace $ - "test " <> testName <> " (" <> contractPath <> ")" - initializeUnitTest opts testContract - void (runUnitTest opts testName (AbiTuple mempty)) - ui0 = - UiVmState - { _uiVm = vm0 - , _uiVmNextStep = script - , _uiVmSolc = Just testContract - , _uiVmDapp = Nothing - , _uiVmStepCount = 0 - , _uiVmFirstState = undefined - , _uiVmFetcher = oracle - , _uiVmMessage = Nothing - , _uiVmSentHashes = Set.empty - } - Just testContract = - view (dappSolcByName . at contractPath) dapp - vm0 = - initialUnitTestVm opts testContract - ui1 = - updateUiVmState ui0 vm0 & set uiVmFirstState ui1 diff --git a/src/hevm/src/EVM/Exec.hs b/src/hevm/src/EVM/Exec.hs deleted file mode 100644 index 1e2da9866..000000000 --- a/src/hevm/src/EVM/Exec.hs +++ /dev/null @@ -1,92 +0,0 @@ -module EVM.Exec where - -import EVM -import EVM.Concrete (createAddress) -import EVM.Symbolic (litAddr) -import EVM.Types - -import qualified EVM.FeeSchedule as FeeSchedule - -import Control.Lens -import Control.Monad.State.Class (MonadState) -import Control.Monad.State.Strict (runState) -import Data.ByteString (ByteString) -import Data.Maybe (isNothing) - -import qualified Control.Monad.State.Class as State - -ethrunAddress :: Addr -ethrunAddress = Addr 0x00a329c0648769a73afac7f9381e08fb43dbea72 - -vmForEthrunCreation :: ByteString -> VM -vmForEthrunCreation creationCode = - (makeVm $ VMOpts - { vmoptContract = initialContract (InitCode (ConcreteBuffer creationCode)) - , vmoptCalldata = (mempty, 0) - , vmoptValue = 0 - , vmoptAddress = createAddress ethrunAddress 1 - , vmoptCaller = litAddr ethrunAddress - , vmoptOrigin = ethrunAddress - , vmoptCoinbase = 0 - , vmoptNumber = 0 - , vmoptTimestamp = 0 - , vmoptBlockGaslimit = 0 - , vmoptGasprice = 0 - , vmoptDifficulty = 0 - , vmoptGas = 0xffffffffffffffff - , vmoptGaslimit = 0xffffffffffffffff - , vmoptBaseFee = 0 - , vmoptPriorityFee = 0 - , vmoptMaxCodeSize = 0xffffffff - , vmoptSchedule = FeeSchedule.berlin - , vmoptChainId = 1 - , vmoptCreate = False - , vmoptStorageModel = ConcreteS - , vmoptTxAccessList = mempty - , vmoptAllowFFI = False - }) & set (env . contracts . at ethrunAddress) - (Just (initialContract (RuntimeCode mempty))) - -exec :: MonadState VM m => m VMResult -exec = - use EVM.result >>= \case - Nothing -> State.state (runState exec1) >> exec - Just x -> return x - -run :: MonadState VM m => m VM -run = - use EVM.result >>= \case - Nothing -> State.state (runState exec1) >> run - Just _ -> State.get - -execWhile :: MonadState VM m => (VM -> Bool) -> m Int -execWhile p = go 0 - where - go i = do - x <- State.get - if p x && isNothing (view result x) - then do - State.state (runState exec1) - go $! (i + 1) - else - return i - --- locateBreakpoint :: UIState -> Text -> Int -> Maybe [(Word256, Vector Bool)] --- locateBreakpoint ui fileName lineNo = do --- (i, (t, s)) <- --- flip find (Map.toList (ui ^. uiSourceCache . sourceFiles)) --- (\(_, (t, _)) -> t == fileName) --- let ls = BS.split 0x0a s --- l = ls !! (lineNo - 1) --- offset = 1 + sum (map ((+ 1) . BS.length) (take (lineNo - 1) ls)) --- horizon = offset + BS.length l --- return $ Map.elems (ui ^. uiVm . _Just . env . solc) --- & map (\c -> ( --- c ^. solcCodehash, --- Vector.create $ new (Seq.length (c ^. solcSrcmap)) >>= \v -> do --- fst $ foldl' (\(!m, !j) (sm@SM { srcMapOffset = o }) -> --- if srcMapFile sm == i && o >= offset && o < horizon --- then (m >> write v j True, j + 1) --- else (m >> write v j False, j + 1)) (return (), 0) (c ^. solcSrcmap) --- return v --- )) diff --git a/src/hevm/src/EVM/Facts.hs b/src/hevm/src/EVM/Facts.hs deleted file mode 100644 index 982f2de2f..000000000 --- a/src/hevm/src/EVM/Facts.hs +++ /dev/null @@ -1,235 +0,0 @@ -{-# Language PartialTypeSignatures #-} -{-# Language FlexibleInstances #-} -{-# Language ExtendedDefaultRules #-} -{-# Language PatternSynonyms #-} -{-# Language RecordWildCards #-} -{-# Language ScopedTypeVariables #-} -{-# Language ViewPatterns #-} - --- Converts between Ethereum contract states and simple trees of --- texts. Dumps and loads such trees as Git repositories (the state --- gets serialized as commits with folders and files). --- --- Example state file hierarchy: --- --- /0123...abc/balance says "0x500" --- /0123...abc/code says "60023429..." --- /0123...abc/nonce says "0x3" --- /0123...abc/storage/0x1 says "0x1" --- /0123...abc/storage/0x2 says "0x0" --- --- This format could easily be serialized into any nested record --- syntax, e.g. JSON. - -module EVM.Facts - ( File (..) - , Fact (..) - , Data (..) - , Path (..) - , apply - , applyCache - , cacheFacts - , contractFacts - , vmFacts - , factToFile - , fileToFact - ) where - -import EVM (VM, Contract, Cache) -import EVM.Symbolic (litWord, forceLit) -import EVM (balance, nonce, storage, bytecode, env, contracts, contract, state, cache, fetched) -import EVM.Types (Addr, Word, SymWord, Buffer(..)) - -import qualified EVM - -import Prelude hiding (Word) - -import Control.Lens (view, set, at, ix, (&), over, assign) -import Control.Monad.State.Strict (execState, when) -import Data.ByteString (ByteString) -import Data.Monoid ((<>)) -import Data.Ord (comparing) -import Data.Set (Set) -import Text.Read (readMaybe) - -import qualified Data.ByteString.Base16 as BS16 -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.Map as Map -import qualified Data.Set as Set - --- We treat everything as ASCII byte strings because --- we only use hex digits (and the letter 'x'). -type ASCII = ByteString - --- When using string literals, default to infer the ASCII type. -default (ASCII) - --- We use the word "fact" to mean one piece of serializable --- information about the state. --- --- Note that Haskell allows this kind of union of records. --- It's convenient here, but typically avoided. -data Fact - = BalanceFact { addr :: Addr, what :: Word } - | NonceFact { addr :: Addr, what :: Word } - | StorageFact { addr :: Addr, what :: Word, which :: Word } - | CodeFact { addr :: Addr, blob :: ByteString } - deriving (Eq, Show) - --- A fact path means something like "/0123...abc/storage/0x1", --- or alternatively "contracts['0123...abc'].storage['0x1']". -data Path = Path [ASCII] ASCII - deriving (Eq, Ord, Show) - --- A fact data is the content of a file. We encapsulate it --- with a newtype to make it easier to change the representation --- (to use bytestrings, some sum type, or whatever). -newtype Data = Data { dataASCII :: ASCII } - deriving (Eq, Ord, Show) - --- We use the word "file" to denote a serialized value at a path. -data File = File { filePath :: Path, fileData :: Data } - deriving (Eq, Ord, Show) - -class AsASCII a where - dump :: a -> ASCII - load :: ASCII -> Maybe a - -instance AsASCII Addr where - dump = Char8.pack . show - load = readMaybe . Char8.unpack - -instance AsASCII Word where - dump = Char8.pack . show - load = readMaybe . Char8.unpack - -instance AsASCII ByteString where - dump x = BS16.encode x <> "\n" - load x = - case BS16.decode . mconcat . BS.split 10 $ x of - Right y -> Just y - _ -> Nothing - -contractFacts :: Addr -> Contract -> [Fact] -contractFacts a x = case view bytecode x of - ConcreteBuffer b -> - storageFacts a x ++ - [ BalanceFact a (view balance x) - , NonceFact a (view nonce x) - , CodeFact a b - ] - SymbolicBuffer b -> - -- here simply ignore storing the bytecode - storageFacts a x ++ - [ BalanceFact a (view balance x) - , NonceFact a (view nonce x) - ] - - -storageFacts :: Addr -> Contract -> [Fact] -storageFacts a x = case view storage x of - EVM.Symbolic _ _ -> [] - EVM.Concrete s -> map f (Map.toList s) - where - f :: (Word, SymWord) -> Fact - f (k, v) = StorageFact - { addr = a - , what = fromIntegral (forceLit v) - , which = fromIntegral k - } - -cacheFacts :: Cache -> Set Fact -cacheFacts c = Set.fromList $ do - (k, v) <- Map.toList (view EVM.fetched c) - contractFacts k v - -vmFacts :: VM -> Set Fact -vmFacts vm = Set.fromList $ do - (k, v) <- Map.toList (view (env . contracts) vm) - contractFacts k v - --- Somewhat stupidly, this function demands that for each contract, --- the code fact for that contract comes before the other facts for --- that contract. This is an incidental thing because right now we --- always initialize contracts starting with the code (to calculate --- the code hash and so on). --- --- Therefore, we need to make sure to sort the fact set in such a way. -apply1 :: VM -> Fact -> VM -apply1 vm fact = - case fact of - CodeFact {..} -> flip execState vm $ do - assign (env . contracts . at addr) (Just (EVM.initialContract (EVM.RuntimeCode (ConcreteBuffer blob)))) - when (view (state . contract) vm == addr) $ EVM.loadContract addr - StorageFact {..} -> - vm & over (env . contracts . ix addr . storage) (EVM.writeStorage (litWord which) (litWord what)) - BalanceFact {..} -> - vm & set (env . contracts . ix addr . balance) what - NonceFact {..} -> - vm & set (env . contracts . ix addr . nonce) what - -apply2 :: VM -> Fact -> VM -apply2 vm fact = - case fact of - CodeFact {..} -> flip execState vm $ do - assign (cache . fetched . at addr) (Just (EVM.initialContract (EVM.RuntimeCode (ConcreteBuffer blob)))) - when (view (state . contract) vm == addr) $ EVM.loadContract addr - StorageFact {..} -> - vm & over (cache . fetched . ix addr . storage) (EVM.writeStorage (litWord which) (litWord what)) - BalanceFact {..} -> - vm & set (cache . fetched . ix addr . balance) what - NonceFact {..} -> - vm & set (cache . fetched . ix addr . nonce) what - --- Sort facts in the right order for `apply1` to work. -instance Ord Fact where - compare = comparing f - where - f :: Fact -> (Int, Addr, Word) - f (CodeFact a _) = (0, a, 0) - f (BalanceFact a _) = (1, a, 0) - f (NonceFact a _) = (2, a, 0) - f (StorageFact a _ x) = (3, a, x) - --- Applies a set of facts to a VM. -apply :: VM -> Set Fact -> VM -apply = - -- The set's ordering is relevant; see `apply1`. - foldl apply1 --- --- Applies a set of facts to a VM. -applyCache :: VM -> Set Fact -> VM -applyCache = - -- The set's ordering is relevant; see `apply1`. - foldl apply2 - -factToFile :: Fact -> File -factToFile fact = case fact of - StorageFact {..} -> mk ["storage"] (dump which) what - BalanceFact {..} -> mk [] "balance" what - NonceFact {..} -> mk [] "nonce" what - CodeFact {..} -> mk [] "code" blob - where - mk :: AsASCII a => [ASCII] -> ASCII -> a -> File - mk prefix base a = - File (Path (dump (addr fact) : prefix) base) - (Data $ dump a) - --- This lets us easier pattern match on serialized things. --- Uses language extensions: `PatternSynonyms` and `ViewPatterns`. -pattern Load :: AsASCII a => a -> ASCII -pattern Load x <- (load -> Just x) - -fileToFact :: File -> Maybe Fact -fileToFact = \case - File (Path [Load a] "code") (Data (Load x)) - -> Just (CodeFact a x) - File (Path [Load a] "balance") (Data (Load x)) - -> Just (BalanceFact a x) - File (Path [Load a] "nonce") (Data (Load x)) - -> Just (NonceFact a x) - File (Path [Load a, "storage"] (Load x)) (Data (Load y)) - -> Just (StorageFact a y x) - _ - -> Nothing diff --git a/src/hevm/src/EVM/Facts/Git.hs b/src/hevm/src/EVM/Facts/Git.hs deleted file mode 100644 index 71c4dcdc1..000000000 --- a/src/hevm/src/EVM/Facts/Git.hs +++ /dev/null @@ -1,49 +0,0 @@ - --- This is a backend for the fact representation that uses a Git --- repository as the store. - -module EVM.Facts.Git - ( saveFacts - , loadFacts - , RepoAt (..) - ) where - -import EVM.Facts (Fact (..), File (..), Path (..), Data (..), fileToFact, factToFile) - -import Control.Lens -import Data.Set (Set) -import Data.Maybe (catMaybes) - -import qualified Data.Set as Set -import qualified Restless.Git as Git - -newtype RepoAt = RepoAt String - deriving (Eq, Ord, Show) - --- For modularity reasons, we have our own file data type that is --- isomorphic with the one in the `restless-git` library. We declare --- the isomorphism so we can go between them easily. -fileRepr :: Iso' File Git.File -fileRepr = iso f g - where - f :: File -> Git.File - f (File (Path ps p) (Data x)) = - Git.File (Git.Path ps p) x - - g :: Git.File -> File - g (Git.File (Git.Path ps p) x) = - File (Path ps p) (Data x) - -saveFacts :: RepoAt -> Set Fact -> IO () -saveFacts (RepoAt repo) facts = - Git.save repo "hevm execution" - (Set.map (view fileRepr . factToFile) facts) - -prune :: Ord a => Set (Maybe a) -> Set a -prune = Set.fromList . catMaybes . Set.toList - -loadFacts :: RepoAt -> IO (Set Fact) -loadFacts (RepoAt src) = - fmap - (prune . Set.map (fileToFact . view (from fileRepr))) - (Git.load src) diff --git a/src/hevm/src/EVM/FeeSchedule.hs b/src/hevm/src/EVM/FeeSchedule.hs deleted file mode 100644 index 3c70fbaf3..000000000 --- a/src/hevm/src/EVM/FeeSchedule.hs +++ /dev/null @@ -1,185 +0,0 @@ -module EVM.FeeSchedule where - -data FeeSchedule n = FeeSchedule - { g_zero :: n - , g_base :: n - , g_verylow :: n - , g_low :: n - , g_mid :: n - , g_high :: n - , g_extcode :: n - , g_balance :: n - , g_sload :: n - , g_jumpdest :: n - , g_sset :: n - , g_sreset :: n - , r_sclear :: n - , g_selfdestruct :: n - , g_selfdestruct_newaccount :: n - , r_selfdestruct :: n - , g_create :: n - , g_codedeposit :: n - , g_call :: n - , g_callvalue :: n - , g_callstipend :: n - , g_newaccount :: n - , g_exp :: n - , g_expbyte :: n - , g_memory :: n - , g_txcreate :: n - , g_txdatazero :: n - , g_txdatanonzero :: n - , g_transaction :: n - , g_log :: n - , g_logdata :: n - , g_logtopic :: n - , g_sha3 :: n - , g_sha3word :: n - , g_copy :: n - , g_blockhash :: n - , g_extcodehash :: n - , g_quaddivisor :: n - , g_ecadd :: n - , g_ecmul :: n - , g_pairing_point :: n - , g_pairing_base :: n - , g_fround :: n - , r_block :: n - , g_cold_sload :: n - , g_cold_account_access :: n - , g_warm_storage_read :: n - , g_access_list_address :: n - , g_access_list_storage_key :: n - } deriving Show - --- For the purposes of this module, we define an EIP as just a fee --- schedule modification. -type EIP n = Num n => FeeSchedule n -> FeeSchedule n - --- EIP150: Gas cost changes for IO-heavy operations --- -eip150 :: EIP n -eip150 fees = fees - { g_extcode = 700 - , g_balance = 400 - , g_sload = 200 - , g_call = 700 - , g_selfdestruct = 5000 - , g_selfdestruct_newaccount = 25000 - } - --- EIP160: EXP cost increase --- -eip160 :: EIP n -eip160 fees = fees - { g_expbyte = 50 } - -homestead :: Num n => FeeSchedule n -homestead = FeeSchedule - { g_zero = 0 - , g_base = 2 - , g_verylow = 3 - , g_low = 5 - , g_mid = 8 - , g_high = 10 - , g_extcode = 20 - , g_balance = 20 - , g_sload = 50 - , g_jumpdest = 1 - , g_sset = 20000 - , g_sreset = 5000 - , r_sclear = 15000 - , g_selfdestruct = 0 - , g_selfdestruct_newaccount = 0 - , r_selfdestruct = 24000 - , g_create = 32000 - , g_codedeposit = 200 - , g_call = 40 - , g_callvalue = 9000 - , g_callstipend = 2300 - , g_newaccount = 25000 - , g_exp = 10 - , g_expbyte = 10 - , g_memory = 3 - , g_txcreate = 32000 - , g_txdatazero = 4 - , g_txdatanonzero = 68 - , g_transaction = 21000 - , g_log = 375 - , g_logdata = 8 - , g_logtopic = 375 - , g_sha3 = 30 - , g_sha3word = 6 - , g_copy = 3 - , g_blockhash = 20 - , g_extcodehash = 400 - , g_quaddivisor = 20 - , g_ecadd = 500 - , g_ecmul = 40000 - , g_pairing_point = 80000 - , g_pairing_base = 100000 - , g_fround = 1 - , r_block = 2000000000000000000 - , g_cold_sload = 2100 - , g_cold_account_access = 2600 - , g_warm_storage_read = 100 - , g_access_list_address = 2400 - , g_access_list_storage_key = 1900 - } - -metropolis :: Num n => FeeSchedule n -metropolis = eip160 . eip150 $ homestead - --- EIP1108: Reduce alt_bn128 precompile gas costs --- -eip1108 :: EIP n -eip1108 fees = fees - { g_ecadd = 150 - , g_ecmul = 6000 - , g_pairing_point = 34000 - , g_pairing_base = 45000 - } - --- EIP1884: Repricing for trie-size-dependent opcodes --- -eip1884 :: EIP n -eip1884 fees = fees - { g_sload = 800 - , g_balance = 700 - , g_extcodehash = 700 - } - --- EIP2028: Transaction data gas cost reduction --- -eip2028 :: EIP n -eip2028 fees = fees - { g_txdatanonzero = 16 - } - --- EIP2200: Structured definitions for gas metering --- -eip2200 :: EIP n -eip2200 fees = fees - { g_sload = 800 - , g_sset = 20000 -- not changed - , g_sreset = 5000 -- not changed - , r_sclear = 15000 -- not changed - } - -istanbul :: Num n => FeeSchedule n -istanbul = eip1108 . eip1884 . eip2028 . eip2200 $ metropolis - - -- EIP2929: Gas cost increases for state access opcodes - -- -eip2929 :: EIP n -eip2929 fees = fees - { g_sload = 100 - , g_sreset = 5000 - 2100 - , g_call = 2600 - , g_balance = 2600 - , g_extcode = 2600 - , g_extcodehash = 2600 - } - -berlin :: Num n => FeeSchedule n -berlin = eip2929 istanbul diff --git a/src/hevm/src/EVM/Fetch.hs b/src/hevm/src/EVM/Fetch.hs deleted file mode 100644 index 477012e80..000000000 --- a/src/hevm/src/EVM/Fetch.hs +++ /dev/null @@ -1,298 +0,0 @@ -{-# Language GADTs #-} -{-# Language StandaloneDeriving #-} -{-# Language LambdaCase #-} - -module EVM.Fetch where - -import Prelude hiding (Word) - -import EVM.ABI -import EVM.Types (Addr, w256, W256, hexText, Word, Buffer(..)) -import EVM.Symbolic (litWord) -import EVM (IsUnique(..), EVM, Contract, Block, initialContract, nonce, balance, external) -import qualified EVM.FeeSchedule as FeeSchedule - -import qualified EVM - -import Control.Lens hiding ((.=)) -import Control.Monad.Reader -import Control.Monad.Trans.Maybe -import Data.SBV.Trans.Control -import qualified Data.SBV.Internals as SBV -import Data.SBV.Trans hiding (Word) -import Data.Aeson -import Data.Aeson.Lens -import qualified Data.ByteString as BS -import Data.Text (Text, unpack, pack) -import Data.Maybe (fromMaybe) - -import qualified Data.Vector as RegularVector -import Network.Wreq -import Network.Wreq.Session (Session) -import System.Process - -import qualified Network.Wreq.Session as Session - --- | Abstract representation of an RPC fetch request -data RpcQuery a where - QueryCode :: Addr -> RpcQuery BS.ByteString - QueryBlock :: RpcQuery Block - QueryBalance :: Addr -> RpcQuery W256 - QueryNonce :: Addr -> RpcQuery W256 - QuerySlot :: Addr -> W256 -> RpcQuery W256 - QueryChainId :: RpcQuery W256 - -data BlockNumber = Latest | BlockNumber W256 - -deriving instance Show (RpcQuery a) - -rpc :: String -> [Value] -> Value -rpc method args = object - [ "jsonrpc" .= ("2.0" :: String) - , "id" .= Number 1 - , "method" .= method - , "params" .= args - ] - -class ToRPC a where - toRPC :: a -> Value - -instance ToRPC Addr where - toRPC = String . pack . show - -instance ToRPC W256 where - toRPC = String . pack . show - -instance ToRPC Bool where - toRPC = Bool - -instance ToRPC BlockNumber where - toRPC Latest = String "latest" - toRPC (BlockNumber n) = String . pack $ show n - -readText :: Read a => Text -> a -readText = read . unpack - -fetchQuery - :: Show a - => BlockNumber - -> (Value -> IO (Maybe Value)) - -> RpcQuery a - -> IO (Maybe a) -fetchQuery n f q = do - x <- case q of - QueryCode addr -> do - m <- f (rpc "eth_getCode" [toRPC addr, toRPC n]) - return $ hexText . view _String <$> m - QueryNonce addr -> do - m <- f (rpc "eth_getTransactionCount" [toRPC addr, toRPC n]) - return $ readText . view _String <$> m - QueryBlock -> do - m <- f (rpc "eth_getBlockByNumber" [toRPC n, toRPC False]) - return $ m >>= parseBlock - QueryBalance addr -> do - m <- f (rpc "eth_getBalance" [toRPC addr, toRPC n]) - return $ readText . view _String <$> m - QuerySlot addr slot -> do - m <- f (rpc "eth_getStorageAt" [toRPC addr, toRPC slot, toRPC n]) - return $ readText . view _String <$> m - QueryChainId -> do - m <- f (rpc "eth_chainId" [toRPC n]) - return $ readText . view _String <$> m - return x - - -parseBlock :: (AsValue s, Show s) => s -> Maybe EVM.Block -parseBlock j = do - coinbase <- readText <$> j ^? key "miner" . _String - timestamp <- litWord . readText <$> j ^? key "timestamp" . _String - number <- readText <$> j ^? key "number" . _String - difficulty <- readText <$> j ^? key "difficulty" . _String - gasLimit <- readText <$> j ^? key "gasLimit" . _String - let baseFee = readText <$> j ^? key "baseFeePerGas" . _String - -- default codesize, default gas limit, default feescedule - return $ EVM.Block coinbase timestamp number difficulty gasLimit (fromMaybe 0 baseFee) 0xffffffff FeeSchedule.berlin - -fetchWithSession :: Text -> Session -> Value -> IO (Maybe Value) -fetchWithSession url sess x = do - r <- asValue =<< Session.post sess (unpack url) x - return (r ^? responseBody . key "result") - -fetchContractWithSession - :: BlockNumber -> Text -> Addr -> Session -> IO (Maybe Contract) -fetchContractWithSession n url addr sess = runMaybeT $ do - let - fetch :: Show a => RpcQuery a -> IO (Maybe a) - fetch = fetchQuery n (fetchWithSession url sess) - - theCode <- MaybeT $ fetch (QueryCode addr) - theNonce <- MaybeT $ fetch (QueryNonce addr) - theBalance <- MaybeT $ fetch (QueryBalance addr) - - return $ - initialContract (EVM.RuntimeCode (ConcreteBuffer theCode)) - & set nonce (w256 theNonce) - & set balance (w256 theBalance) - & set external True - -fetchSlotWithSession - :: BlockNumber -> Text -> Session -> Addr -> W256 -> IO (Maybe Word) -fetchSlotWithSession n url sess addr slot = - fmap w256 <$> - fetchQuery n (fetchWithSession url sess) (QuerySlot addr slot) - -fetchBlockWithSession - :: BlockNumber -> Text -> Session -> IO (Maybe Block) -fetchBlockWithSession n url sess = - fetchQuery n (fetchWithSession url sess) QueryBlock - -fetchBlockFrom :: BlockNumber -> Text -> IO (Maybe Block) -fetchBlockFrom n url = - Session.withAPISession - (fetchBlockWithSession n url) - -fetchContractFrom :: BlockNumber -> Text -> Addr -> IO (Maybe Contract) -fetchContractFrom n url addr = - Session.withAPISession - (fetchContractWithSession n url addr) - -fetchSlotFrom :: BlockNumber -> Text -> Addr -> W256 -> IO (Maybe Word) -fetchSlotFrom n url addr slot = - Session.withAPISession - (\s -> fetchSlotWithSession n url s addr slot) - -http :: BlockNumber -> Text -> Fetcher -http n url = oracle Nothing (Just (n, url)) True - -zero :: Fetcher -zero = oracle Nothing Nothing True - --- smtsolving + (http or zero) -oracle :: Maybe SBV.State -> Maybe (BlockNumber, Text) -> Bool -> Fetcher -oracle smtstate info ensureConsistency q = do - case q of - EVM.PleaseDoFFI vals continue -> case vals of - cmd : args -> do - (_, stdout', _) <- readProcessWithExitCode cmd args "" - pure . continue . encodeAbiValue $ - AbiTuple (RegularVector.fromList [ AbiBytesDynamic . hexText . pack $ stdout']) - _ -> error (show vals) - - EVM.PleaseAskSMT branchcondition pathconditions continue -> - case smtstate of - Nothing -> return $ continue EVM.Unknown - Just state -> flip runReaderT state $ SBV.runQueryT $ do - let pathconds = sAnd pathconditions - -- Is is possible to satisfy the condition? - continue <$> checkBranch pathconds branchcondition ensureConsistency - - -- if we are using a symbolic storage model, - -- we generate a new array to the fetched contract here - EVM.PleaseFetchContract addr model continue -> do - contract <- case info of - Nothing -> return $ Just $ initialContract (EVM.RuntimeCode mempty) - Just (n, url) -> fetchContractFrom n url addr - case contract of - Just x -> case model of - EVM.ConcreteS -> return $ continue x - EVM.InitialS -> return $ continue $ x - & set EVM.storage (EVM.Symbolic [] $ SBV.sListArray 0 []) - EVM.SymbolicS -> case smtstate of - Nothing -> return (continue $ x - & set EVM.storage (EVM.Symbolic [] $ SBV.sListArray 0 [])) - - Just state -> - flip runReaderT state $ SBV.runQueryT $ do - store <- freshArray_ Nothing - return $ continue $ x - & set EVM.storage (EVM.Symbolic [] store) - Nothing -> error ("oracle error: " ++ show q) - - EVM.PleaseMakeUnique val pathconditions continue -> - case smtstate of - Nothing -> return $ continue Multiple - Just state -> flip runReaderT state $ SBV.runQueryT $ do - constrain $ sAnd $ pathconditions <> [val .== val] -- dummy proposition just to make sure `val` is defined when we do `getValue` later. - checkSat >>= \case - Sat -> do - val' <- getValue val - s <- checksat (val ./= literal val') - case s of - Unsat -> pure $ continue $ Unique val' - _ -> pure $ continue Multiple - Unsat -> pure $ continue InconsistentU - Unk -> pure $ continue TimeoutU - DSat _ -> error "unexpected DSAT" - - - EVM.PleaseFetchSlot addr slot continue -> - case info of - Nothing -> return (continue 0) - Just (n, url) -> - fetchSlotFrom n url addr (fromIntegral slot) >>= \case - Just x -> return (continue x) - Nothing -> - error ("oracle error: " ++ show q) - -type Fetcher = EVM.Query -> IO (EVM ()) - -checksat :: SBool -> Query CheckSatResult -checksat b = do push 1 - constrain b - m <- checkSat - pop 1 - return m - --- | Checks which branches are satisfiable, checking the pathconditions for consistency --- if the third argument is true. --- When in debug mode, we do not want to be able to navigate to dead paths, --- but for normal execution paths with inconsistent pathconditions --- will be pruned anyway. -checkBranch :: SBool -> SBool -> Bool -> Query EVM.BranchCondition -checkBranch pathconds branchcondition False = do - constrain pathconds - checksat branchcondition >>= \case - -- the condition is unsatisfiable - Unsat -> -- if pathconditions are consistent then the condition must be false - return $ EVM.Case False - -- Sat means its possible for condition to hold - Sat -> -- is its negation also possible? - checksat (sNot branchcondition) >>= \case - -- No. The condition must hold - Unsat -> return $ EVM.Case True - -- Yes. Both branches possible - Sat -> return EVM.Unknown - -- Explore both branches in case of timeout - Unk -> return EVM.Unknown - DSat _ -> error "checkBranch: unexpected SMT result" - -- If the query times out, we simply explore both paths - Unk -> return EVM.Unknown - DSat _ -> error "checkBranch: unexpected SMT result" - -checkBranch pathconds branchcondition True = do - constrain pathconds - checksat branchcondition >>= \case - -- the condition is unsatisfiable - Unsat -> -- are the pathconditions even consistent? - checksat (sNot branchcondition) >>= \case - -- No. We are on an inconsistent path. - Unsat -> return EVM.Inconsistent - -- Yes. The condition must be false. - Sat -> return $ EVM.Case False - -- Assume the negated condition is still possible. - Unk -> return $ EVM.Case False - DSat _ -> error "checkBranch: unexpected SMT result" - -- Sat means its possible for condition to hold - Sat -> -- is its negation also possible? - checksat (sNot branchcondition) >>= \case - -- No. The condition must hold - Unsat -> return $ EVM.Case True - -- Yes. Both branches possible - Sat -> return EVM.Unknown - -- Explore both branches in case of timeout - Unk -> return EVM.Unknown - DSat _ -> error "checkBranch: unexpected SMT result" - - -- If the query times out, we simply explore both paths - Unk -> return EVM.Unknown - DSat _ -> error "Internal Error: unexpected SMT result" diff --git a/src/hevm/src/EVM/Format.hs b/src/hevm/src/EVM/Format.hs deleted file mode 100644 index 451a2ad2a..000000000 --- a/src/hevm/src/EVM/Format.hs +++ /dev/null @@ -1,456 +0,0 @@ -{-# Language DataKinds #-} -{-# Language ImplicitParams #-} -{-# Language TemplateHaskell #-} -module EVM.Format where - -import Prelude hiding (Word) -import qualified EVM -import EVM.Dapp (DappInfo (..), dappSolcByHash, dappAbiMap, showTraceLocation, dappEventMap, dappErrorMap) -import EVM.Dapp (DappContext (..), contextInfo, contextEnv) -import EVM.Concrete ( wordValue ) -import EVM (VM, VMResult(..), cheatCode, traceForest, traceData, Error (..), result) -import EVM (Trace, TraceData (..), Log (..), Query (..), FrameContext (..), Storage(..)) -import EVM.SymExec -import EVM.Symbolic (len, litWord) -import EVM.Types (maybeLitWord, Word (..), Whiff(..), SymWord(..), W256 (..), num, word) -import EVM.Types (Addr, Buffer(..), ByteStringS(..)) -import EVM.ABI (AbiValue (..), Event (..), AbiType (..), SolError (..)) -import EVM.ABI (Indexed (NotIndexed), getAbiSeq) -import EVM.ABI (parseTypeName, formatString) -import EVM.Solidity (SolcContract(..), contractName, abiMap) -import EVM.Solidity (methodOutput, methodSignature, methodName) - -import Control.Arrow ((>>>)) -import Control.Lens (view, preview, ix, _2, to, makeLenses, over, each, (^?!)) -import Data.Binary.Get (runGetOrFail) -import Data.Bits (shiftR) -import Data.ByteString (ByteString) -import Data.ByteString.Builder (byteStringHex, toLazyByteString) -import Data.ByteString.Lazy (toStrict, fromStrict) -import Data.DoubleWord (signedWord) -import Data.Foldable (toList) -import Data.Maybe (catMaybes, fromMaybe) -import Data.Text (Text, pack, unpack, intercalate) -import Data.Text (dropEnd, splitOn) -import Data.Text.Encoding (decodeUtf8, decodeUtf8') -import Data.Tree (Tree (Node)) -import Data.Tree.View (showTree) -import Data.Vector (Vector) -import Data.Word (Word32) - -import qualified Data.ByteString as BS -import qualified Data.Char as Char -import qualified Data.Map as Map -import qualified Data.Text as Text - -data Signedness = Signed | Unsigned - deriving (Show) - -showDec :: Signedness -> W256 -> Text -showDec signed (W256 w) = - let - i = case signed of - Signed -> num (signedWord w) - Unsigned -> num w - in - if i == num cheatCode - then "" - else if (i :: Integer) == 2 ^ (256 :: Integer) - 1 - then "MAX_UINT256" - else Text.pack (show (i :: Integer)) - -showWordExact :: Word -> Text -showWordExact (C _ (W256 w)) = humanizeInteger w - -showWordExplanation :: W256 -> DappInfo -> Text -showWordExplanation w _ | w > 0xffffffff = showDec Unsigned w -showWordExplanation w dapp = - case Map.lookup (fromIntegral w) (view dappAbiMap dapp) of - Nothing -> showDec Unsigned w - Just x -> "keccak(\"" <> view methodSignature x <> "\")" - -humanizeInteger :: (Num a, Integral a, Show a) => a -> Text -humanizeInteger = - Text.intercalate "," - . reverse - . map Text.reverse - . Text.chunksOf 3 - . Text.reverse - . Text.pack - . show - -showAbiValue :: (?context :: DappContext) => AbiValue -> Text -showAbiValue (AbiBytes _ bs) = - formatBytes bs -- opportunistically decodes recognisable strings -showAbiValue (AbiAddress addr) = - let dappinfo = view contextInfo ?context - contracts = view contextEnv ?context - name = case (Map.lookup addr contracts) of - Nothing -> "" - Just contract -> - let hash = view EVM.codehash contract - solcContract = (preview (dappSolcByHash . ix hash . _2) dappinfo) - in maybeContractName' solcContract - in - name <> "@" <> (pack $ show addr) -showAbiValue v = pack $ show v - -showAbiValues :: (?context :: DappContext) => Vector AbiValue -> Text -showAbiValues vs = parenthesise (textAbiValues vs) - -textAbiValues :: (?context :: DappContext) => Vector AbiValue -> [Text] -textAbiValues vs = toList (fmap showAbiValue vs) - -textValues :: (?context :: DappContext) => [AbiType] -> Buffer -> [Text] -textValues ts (SymbolicBuffer _) = [pack $ show t | t <- ts] -textValues ts (ConcreteBuffer bs) = - case runGetOrFail (getAbiSeq (length ts) ts) (fromStrict bs) of - Right (_, _, xs) -> textAbiValues xs - Left (_, _, _) -> [formatBinary bs] - -parenthesise :: [Text] -> Text -parenthesise ts = "(" <> intercalate ", " ts <> ")" - -showValues :: (?context :: DappContext) => [AbiType] -> Buffer -> Text -showValues ts b = parenthesise $ textValues ts b - -showValue :: (?context :: DappContext) => AbiType -> Buffer -> Text -showValue t b = head $ textValues [t] b - -showCall :: (?context :: DappContext) => [AbiType] -> Buffer -> Text -showCall ts (SymbolicBuffer bs) = showValues ts $ SymbolicBuffer (drop 4 bs) -showCall ts (ConcreteBuffer bs) = showValues ts $ ConcreteBuffer (BS.drop 4 bs) - -showError :: (?context :: DappContext) => ByteString -> Text -showError bs = - let dappinfo = view contextInfo ?context - bs4 = BS.take 4 bs - in case Map.lookup (word bs4) (view dappErrorMap dappinfo) of - Just (SolError errName ts) -> errName <> " " <> showCall ts (ConcreteBuffer bs) - Nothing -> case bs4 of - -- Method ID for Error(string) - "\b\195y\160" -> showCall [AbiStringType] (ConcreteBuffer bs) - _ -> formatBinary bs - --- the conditions under which bytes will be decoded and rendered as a string -isPrintable :: ByteString -> Bool -isPrintable = - decodeUtf8' >>> - either - (const False) - (Text.all (\c-> Char.isPrint c && (not . Char.isControl) c)) - -formatBytes :: ByteString -> Text -formatBytes b = - let (s, _) = BS.spanEnd (== 0) b - in - if isPrintable s - then formatBString s - else formatBinary b - -formatSBytes :: Buffer -> Text -formatSBytes (SymbolicBuffer b) = "<" <> pack (show (length b)) <> " symbolic bytes>" -formatSBytes (ConcreteBuffer b) = formatBytes b - --- a string that came from bytes, displayed with special quotes -formatBString :: ByteString -> Text -formatBString b = mconcat [ "«", Text.dropAround (=='"') (pack $ formatString b), "»" ] - -formatSString :: Buffer -> Text -formatSString (SymbolicBuffer bs) = "<" <> pack (show (length bs)) <> " symbolic bytes (string)>" -formatSString (ConcreteBuffer bs) = pack $ formatString bs - -formatBinary :: ByteString -> Text -formatBinary = - (<>) "0x" . decodeUtf8 . toStrict . toLazyByteString . byteStringHex - -formatSBinary :: Buffer -> Text -formatSBinary (SymbolicBuffer bs) = "<" <> pack (show (length bs)) <> " symbolic bytes>" -formatSBinary (ConcreteBuffer bs) = formatBinary bs - -showTraceTree :: DappInfo -> VM -> Text -showTraceTree dapp vm = - let forest = traceForest vm - traces = fmap (fmap (unpack . showTrace dapp vm)) forest - in pack $ concatMap showTree traces - -unindexed :: [(Text, AbiType, Indexed)] -> [AbiType] -unindexed ts = [t | (_, t, NotIndexed) <- ts] - -showTrace :: DappInfo -> VM -> Trace -> Text -showTrace dapp vm trace = - let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts } - in let - pos = - case showTraceLocation dapp trace of - Left x -> " \x1b[1m" <> x <> "\x1b[0m" - Right x -> " \x1b[1m(" <> x <> ")\x1b[0m" - fullAbiMap = view dappAbiMap dapp - in case view traceData trace of - EventTrace (Log _ bytes topics) -> - let logn = mconcat - [ "\x1b[36m" - , "log" <> (pack (show (length topics))) - , parenthesise ((map (pack . show) topics) ++ [formatSBinary bytes]) - , "\x1b[0m" - ] <> pos - knownTopic name types = mconcat - [ "\x1b[36m" - , name - , showValues (unindexed types) bytes - -- todo: show indexed - , "\x1b[0m" - ] <> pos - lognote sig usr = mconcat - [ "\x1b[36m" - , "LogNote" - , parenthesise [sig, usr, "..."] - , "\x1b[0m" - ] <> pos - in case topics of - [] -> - logn - (t1:_) -> - case maybeLitWord t1 of - Just topic -> - case Map.lookup (wordValue topic) (view dappEventMap dapp) of - Just (Event name _ types) -> - knownTopic name types - Nothing -> - case topics of - [_, t2, _, _] -> - -- check for ds-note logs.. possibly catching false positives - -- event LogNote( - -- bytes4 indexed sig, - -- address indexed usr, - -- bytes32 indexed arg1, - -- bytes32 indexed arg2, - -- bytes data - -- ) anonymous; - let - sig = fromIntegral $ shiftR (wordValue topic) 224 :: Word32 - usr = case maybeLitWord t2 of - Just w -> - pack $ show $ (fromIntegral w :: Addr) - Nothing -> - "" - in - case Map.lookup sig (view dappAbiMap dapp) of - Just m -> - lognote (view methodSignature m) usr - Nothing -> - logn - _ -> - logn - Nothing -> - logn - - QueryTrace q -> - case q of - PleaseFetchContract addr _ _ -> - "fetch contract " <> pack (show addr) <> pos - PleaseFetchSlot addr slot _ -> - "fetch storage slot " <> pack (show slot) <> " from " <> pack (show addr) <> pos - PleaseAskSMT {} -> - "ask smt" <> pos - PleaseMakeUnique {} -> - "make unique value" <> pos - PleaseDoFFI cmd _ -> - "execute ffi " <> pack (show cmd) <> pos - - ErrorTrace e -> - case e of - Revert out -> - "\x1b[91merror\x1b[0m " <> "Revert " <> showError out <> pos - _ -> - "\x1b[91merror\x1b[0m " <> pack (show e) <> pos - - ReturnTrace out (CallContext _ _ _ _ _ (Just abi) _ _ _) -> - "← " <> - case Map.lookup (fromIntegral abi) fullAbiMap of - Just m -> - case unzip (view methodOutput m) of - ([], []) -> - formatSBinary out - (_, ts) -> - showValues ts out - Nothing -> - formatSBinary out - ReturnTrace out (CallContext {}) -> - "← " <> formatSBinary out - ReturnTrace out (CreationContext {}) -> - "← " <> pack (show (len out)) <> " bytes of code" - - EntryTrace t -> - t - FrameTrace (CreationContext addr hash _ _ ) -> - "create " - <> maybeContractName (preview (dappSolcByHash . ix hash . _2) dapp) - <> "@" <> pack (show addr) - <> pos - FrameTrace (CallContext target context _ _ hash abi calldata _ _) -> - let calltype = if target == context - then "call " - else "delegatecall " - in case preview (dappSolcByHash . ix hash . _2) dapp of - Nothing -> - calltype - <> pack (show target) - <> pack "::" - <> case Map.lookup (fromIntegral (fromMaybe 0x00 abi)) fullAbiMap of - Just m -> - "\x1b[1m" - <> view methodName m - <> "\x1b[0m" - <> showCall (catMaybes (getAbiTypes (view methodSignature m))) calldata - Nothing -> - formatSBinary calldata - <> pos - - Just solc -> - calltype - <> "\x1b[1m" - <> view (contractName . to contractNamePart) solc - <> "::" - <> maybe "[fallback function]" - (fromMaybe "[unknown method]" . maybeAbiName solc) - abi - <> maybe ("(" <> formatSBinary calldata <> ")") - (\x -> showCall (catMaybes x) calldata) - (abi >>= fmap getAbiTypes . maybeAbiName solc) - <> "\x1b[0m" - <> pos - -getAbiTypes :: Text -> [Maybe AbiType] -getAbiTypes abi = map (parseTypeName mempty) types - where - types = - filter (/= "") $ - splitOn "," (dropEnd 1 (last (splitOn "(" abi))) - -maybeContractName :: Maybe SolcContract -> Text -maybeContractName = - maybe "" (view (contractName . to contractNamePart)) - -maybeContractName' :: Maybe SolcContract -> Text -maybeContractName' = - maybe "" (view (contractName . to contractNamePart)) - -maybeAbiName :: SolcContract -> Word -> Maybe Text -maybeAbiName solc abi = preview (abiMap . ix (fromIntegral abi) . methodSignature) solc - -contractNamePart :: Text -> Text -contractNamePart x = Text.split (== ':') x !! 1 - -contractPathPart :: Text -> Text -contractPathPart x = Text.split (== ':') x !! 0 - -prettyvmresult :: (?context :: DappContext) => VMResult -> String -prettyvmresult (EVM.VMFailure (EVM.Revert "")) = "Revert" -prettyvmresult (EVM.VMFailure (EVM.Revert msg)) = "Revert" ++ (unpack $ showError msg) -prettyvmresult (EVM.VMFailure (EVM.UnrecognizedOpcode 254)) = "Assertion violation" -prettyvmresult (EVM.VMFailure err) = "Failed: " <> show err -prettyvmresult (EVM.VMSuccess (ConcreteBuffer msg)) = - if BS.null msg - then "Stop" - else "Return: " <> show (ByteStringS msg) -prettyvmresult (EVM.VMSuccess (SymbolicBuffer msg)) = - "Return: " <> show (length msg) <> " symbolic bytes" - -currentSolc :: DappInfo -> VM -> Maybe SolcContract -currentSolc dapp vm = - let - this = vm ^?! EVM.env . EVM.contracts . ix (view (EVM.state . EVM.contract) vm) - h = view EVM.codehash this - in - preview (dappSolcByHash . ix h . _2) dapp - --- TODO: display in an 'act' format - --- TreeLine describes a singe line of the tree --- it contains the indentation which is prefixed to it --- and its content which contains the rest -data TreeLine = TreeLine { - _indent :: String, - _content :: String - } - -makeLenses ''TreeLine - --- SHOW TREE - -showTreeIndentSymbol :: Bool -- ^ isLastChild - -> Bool -- ^ isTreeHead - -> String -showTreeIndentSymbol True True = "\x2514" -- └ -showTreeIndentSymbol False True = "\x251c" -- ├ -showTreeIndentSymbol True False = " " -showTreeIndentSymbol False False = "\x2502" -- │ - -flattenTree :: Int -> -- total number of cases - Int -> -- case index - Tree [String] -> - [TreeLine] --- this case should never happen for our use case, here for generality -flattenTree _ _ (Node [] _) = [] - -flattenTree totalCases i (Node (x:xs) cs) = let - isLastCase = i + 1 == totalCases - indenthead = showTreeIndentSymbol isLastCase True <> " " <> show i <> " " - indentchild = showTreeIndentSymbol isLastCase False <> " " - in TreeLine indenthead x - : ((TreeLine indentchild <$> xs) ++ over (each . indent) ((<>) indentchild) (flattenForest cs)) - -flattenForest :: [Tree [String]] -> [TreeLine] -flattenForest forest = concat $ zipWith (flattenTree (length forest)) [0..] forest - -leftpad :: Int -> String -> String -leftpad n = (<>) $ replicate n ' ' - -showTree' :: Tree [String] -> String -showTree' (Node s []) = unlines s -showTree' (Node _ children) = - let - treeLines = flattenForest children - maxIndent = 2 + maximum (length . _indent <$> treeLines) - showTreeLine (TreeLine colIndent colContent) = - let indentSize = maxIndent - length colIndent - in colIndent <> leftpad indentSize colContent - in unlines $ showTreeLine <$> treeLines - - --- RENDER TREE - -showStorage :: [(SymWord, SymWord)] -> [String] -showStorage = fmap (\(k, v) -> show k <> " => " <> show v) - -showLeafInfo :: DappInfo -> BranchInfo -> [String] -showLeafInfo srcInfo (BranchInfo vm _) = let - ?context = DappContext { _contextInfo = srcInfo, _contextEnv = vm ^?! EVM.env . EVM.contracts } - in let - self = view (EVM.state . EVM.contract) vm - updates = case view (EVM.env . EVM.contracts) vm ^?! ix self . EVM.storage of - Symbolic v _ -> v - Concrete x -> [(litWord k,v) | (k, v) <- Map.toList x] - showResult = [prettyvmresult res | Just res <- [view result vm]] - in showResult - ++ showStorage updates - ++ [""] - -showBranchInfoWithAbi :: DappInfo -> BranchInfo -> [String] -showBranchInfoWithAbi _ (BranchInfo _ Nothing) = [""] -showBranchInfoWithAbi srcInfo (BranchInfo vm (Just y)) = - case y of - (IsZero (Eq (Literal x) _)) -> - let - abimap = view abiMap <$> currentSolc srcInfo vm - method = abimap >>= Map.lookup (num x) - in [maybe (show y) (show . view methodSignature) method] - y' -> [show y'] - -renderTree :: (a -> [String]) - -> (a -> [String]) - -> Tree a - -> Tree [String] -renderTree showBranch showLeaf (Node b []) = Node (showBranch b ++ showLeaf b) [] -renderTree showBranch showLeaf (Node b cs) = Node (showBranch b) (renderTree showBranch showLeaf <$> cs) diff --git a/src/hevm/src/EVM/Hexdump.hs b/src/hevm/src/EVM/Hexdump.hs deleted file mode 100644 index ffe7b989d..000000000 --- a/src/hevm/src/EVM/Hexdump.hs +++ /dev/null @@ -1,129 +0,0 @@ --- Copyright (c) 2011, Galois Inc. All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are met: --- --- * Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- * Redistributions in binary form must reproduce the above --- copyright notice, this list of conditions and the following --- disclaimer in the documentation and/or other materials provided --- with the distribution. --- --- * Neither the name of Trevor Elliott nor the names of other --- contributors may be used to endorse or promote products derived --- from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS --- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT --- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR --- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT --- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT --- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, --- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY --- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT --- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE --- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --- - -module EVM.Hexdump (prettyHex, simpleHex) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as B (length, unpack) -import qualified Data.ByteString.Char8 as B8 (unpack) -import Data.Char (isAscii, isControl) -import Data.List (intercalate, transpose, unfoldr) -import Numeric (showHex) - -byteWidth :: Num a => a -byteWidth = 2 -- Width of an padded 'Word8' - -numWordBytes :: Num a => a -numWordBytes = 4 -- Number of bytes to group into a 32-bit word - --- |'prettyHex' renders a 'ByteString' as a multi-line 'String' complete with --- addressing, hex digits, and ASCII representation. --- --- Sample output --- --- @Length: 100 (0x64) bytes ---0000: 4b c1 ad 8a 5b 47 d7 57 48 64 e7 cc 5e b5 2f 6e K...[G.WHd..^./n ---0010: c5 b3 a4 73 44 3b 97 53 99 2d 54 e7 1b 2f 91 12 ...sD;.S.-T../.. ---0020: c8 1a ff c4 3b 2b 72 ea 97 e2 9f e2 93 ad 23 79 ....;+r.......#y ---0030: e8 0f 08 54 02 14 fa 09 f0 2d 34 c9 08 6b e1 64 ...T.....-4..k.d ---0040: d1 c5 98 7e d6 a1 98 e2 97 da 46 68 4e 60 11 15 ...~......FhN`.. ---0050: d8 32 c6 0b 70 f5 2e 76 7f 8d f2 3b ed de 90 c6 .2..p..v...;.... ---0060: 93 12 9c e1 ....@ -prettyHex :: Int -> ByteString -> String -prettyHex hexDisplayWidth bs = unlines (header : body) - where - numLineWords = 4 -- Number of words to group onto a line - addressWidth = 4 -- Minimum width of a padded address - numLineBytes = numLineWords * numWordBytes -- Number of bytes on a line - replacementChar = '.' -- 'Char' to use for non-printable characters - - header = "Length: " ++ show (B.length bs) - ++ " (0x" ++ showHex (B.length bs) ") bytes" - - body = map (intercalate " ") - $ transpose [mkLineNumbers, mkHexDisplay bs, mkAsciiDump bs] - - mkHexDisplay - = padLast hexDisplayWidth - . map (intercalate " ") . group numLineWords - . map (intercalate " ") . group numWordBytes - . map (paddedShowHex byteWidth) - . B.unpack - - mkAsciiDump = group numLineBytes . cleanString . B8.unpack - - cleanString = map go - where - go x | isWorthPrinting x = x - | otherwise = replacementChar - - mkLineNumbers = [paddedShowHex addressWidth (x * numLineBytes) ++ ":" - | x <- [0 .. (B.length bs - 1) `div` numLineBytes] ] - - padLast w [x] = [x ++ replicate (w - length x) ' '] - padLast w (x:xs) = x : padLast w xs - padLast _ [] = [] - --- |'paddedShowHex' displays a number in hexidecimal and pads the number --- with 0 so that it has a minimum length of @w@. -paddedShowHex :: (Show a, Integral a) => Int -> a -> String -paddedShowHex w n = pad ++ str - where - str = showHex n "" - pad = replicate (w - length str) '0' - - --- |'simpleHex' converts a 'ByteString' to a 'String' showing the octets --- grouped in 32-bit words. --- --- Sample output --- --- @4b c1 ad 8a 5b 47 d7 57@ -simpleHex :: ByteString -> String -simpleHex = intercalate " " - . map (intercalate " ") . group numWordBytes - . map (paddedShowHex byteWidth) - . B.unpack - --- |'isWorthPrinting' returns 'True' for non-control ascii characters. --- These characters will all fit in a single character when rendered. -isWorthPrinting :: Char -> Bool -isWorthPrinting x = isAscii x && not (isControl x) - --- |'group' breaks up a list into sublists of size @n@. The last group --- may be smaller than @n@ elements. When @n@ less not positive the --- list is returned as one sublist. -group :: Int -> [a] -> [[a]] -group n - | n <= 0 = (:[]) - | otherwise = unfoldr go - where - go [] = Nothing - go xs = Just (splitAt n xs) diff --git a/src/hevm/src/EVM/Op.hs b/src/hevm/src/EVM/Op.hs deleted file mode 100644 index 54e584735..000000000 --- a/src/hevm/src/EVM/Op.hs +++ /dev/null @@ -1,172 +0,0 @@ -module EVM.Op - ( Op (..) - , opString - ) where - -import EVM.Types (SymWord) -import Data.Word (Word8) -import Numeric (showHex) - -data Op - = OpStop - | OpAdd - | OpMul - | OpSub - | OpDiv - | OpSdiv - | OpMod - | OpSmod - | OpAddmod - | OpMulmod - | OpExp - | OpSignextend - | OpLt - | OpGt - | OpSlt - | OpSgt - | OpEq - | OpIszero - | OpAnd - | OpOr - | OpXor - | OpNot - | OpByte - | OpShl - | OpShr - | OpSar - | OpSha3 - | OpAddress - | OpBalance - | OpOrigin - | OpCaller - | OpCallvalue - | OpCalldataload - | OpCalldatasize - | OpCalldatacopy - | OpCodesize - | OpCodecopy - | OpGasprice - | OpExtcodesize - | OpExtcodecopy - | OpReturndatasize - | OpReturndatacopy - | OpExtcodehash - | OpBlockhash - | OpCoinbase - | OpTimestamp - | OpNumber - | OpDifficulty - | OpGaslimit - | OpChainid - | OpSelfbalance - | OpPop - | OpMload - | OpMstore - | OpMstore8 - | OpSload - | OpSstore - | OpJump - | OpJumpi - | OpPc - | OpMsize - | OpGas - | OpJumpdest - | OpCreate - | OpCall - | OpStaticcall - | OpCallcode - | OpReturn - | OpDelegatecall - | OpCreate2 - | OpRevert - | OpSelfdestruct - | OpDup !Word8 - | OpSwap !Word8 - | OpLog !Word8 - | OpPush !SymWord - | OpUnknown Word8 - deriving (Show, Eq) - -opString :: (Integral a, Show a) => (a, Op) -> String -opString (i, o) = let showPc x | x < 0x10 = '0' : showHex x "" - | otherwise = showHex x "" - in showPc i <> " " ++ case o of - OpStop -> "STOP" - OpAdd -> "ADD" - OpMul -> "MUL" - OpSub -> "SUB" - OpDiv -> "DIV" - OpSdiv -> "SDIV" - OpMod -> "MOD" - OpSmod -> "SMOD" - OpAddmod -> "ADDMOD" - OpMulmod -> "MULMOD" - OpExp -> "EXP" - OpSignextend -> "SIGNEXTEND" - OpLt -> "LT" - OpGt -> "GT" - OpSlt -> "SLT" - OpSgt -> "SGT" - OpEq -> "EQ" - OpIszero -> "ISZERO" - OpAnd -> "AND" - OpOr -> "OR" - OpXor -> "XOR" - OpNot -> "NOT" - OpByte -> "BYTE" - OpShl -> "SHL" - OpShr -> "SHR" - OpSar -> "SAR" - OpSha3 -> "SHA3" - OpAddress -> "ADDRESS" - OpBalance -> "BALANCE" - OpOrigin -> "ORIGIN" - OpCaller -> "CALLER" - OpCallvalue -> "CALLVALUE" - OpCalldataload -> "CALLDATALOAD" - OpCalldatasize -> "CALLDATASIZE" - OpCalldatacopy -> "CALLDATACOPY" - OpCodesize -> "CODESIZE" - OpCodecopy -> "CODECOPY" - OpGasprice -> "GASPRICE" - OpExtcodesize -> "EXTCODESIZE" - OpExtcodecopy -> "EXTCODECOPY" - OpReturndatasize -> "RETURNDATASIZE" - OpReturndatacopy -> "RETURNDATACOPY" - OpExtcodehash -> "EXTCODEHASH" - OpBlockhash -> "BLOCKHASH" - OpCoinbase -> "COINBASE" - OpTimestamp -> "TIMESTAMP" - OpNumber -> "NUMBER" - OpDifficulty -> "DIFFICULTY" - OpGaslimit -> "GASLIMIT" - OpChainid -> "CHAINID" - OpSelfbalance -> "SELFBALANCE" - OpPop -> "POP" - OpMload -> "MLOAD" - OpMstore -> "MSTORE" - OpMstore8 -> "MSTORE8" - OpSload -> "SLOAD" - OpSstore -> "SSTORE" - OpJump -> "JUMP" - OpJumpi -> "JUMPI" - OpPc -> "PC" - OpMsize -> "MSIZE" - OpGas -> "GAS" - OpJumpdest -> "JUMPDEST" - OpCreate -> "CREATE" - OpCall -> "CALL" - OpStaticcall -> "STATICCALL" - OpCallcode -> "CALLCODE" - OpReturn -> "RETURN" - OpDelegatecall -> "DELEGATECALL" - OpCreate2 -> "CREATE2" - OpSelfdestruct -> "SELFDESTRUCT" - OpDup x -> "DUP" ++ show x - OpSwap x -> "SWAP" ++ show x - OpLog x -> "LOG" ++ show x - OpPush x -> "PUSH " ++ show x - OpRevert -> "REVERT" - OpUnknown x -> case x of - 254 -> "INVALID" - _ -> "UNKNOWN " ++ (showHex x "") diff --git a/src/hevm/src/EVM/Patricia.hs b/src/hevm/src/EVM/Patricia.hs deleted file mode 100644 index 826a64ae9..000000000 --- a/src/hevm/src/EVM/Patricia.hs +++ /dev/null @@ -1,230 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE FlexibleInstances #-} - -module EVM.Patricia where - -import EVM.RLP -import EVM.Types hiding (Literal) - -import Control.Monad.Free -import Control.Monad.State -import Data.ByteString (ByteString) -import Data.Foldable (toList) -import Data.List (stripPrefix) -import Data.Sequence (Seq) - -import qualified Data.ByteString as BS -import qualified Data.Map as Map -import qualified Data.Sequence as Seq - -data KV k v a - = Put k v a - | Get k (v -> a) - deriving (Functor) - -newtype DB k v a = DB (Free (KV k v) a) - deriving (Functor, Applicative, Monad) - -insertDB :: k -> v -> DB k v () -insertDB k v = DB $ liftF $ Put k v () - -lookupDB :: k -> DB k v v -lookupDB k = DB $ liftF $ Get k id - --- Collapses a series of puts and gets down to the monad of your choice -runDB :: Monad m - => (k -> v -> m ()) -- ^ The 'put' function for our desired monad - -> (k -> m v) -- ^ The 'get' function for the same monad - -> DB k v a -- ^ The puts and gets to execute - -> m a -runDB putt gett (DB ops) = go ops - where - go (Pure a) = return a - go (Free (Put k v next)) = putt k v >> go next - go (Free (Get k handler)) = gett k >>= go . handler - -type Path = [Nibble] - -data Ref = Hash ByteString | Literal Node - deriving (Eq) - -instance Show Ref where - show (Hash d) = show (ByteStringS d) - show (Literal n) = show n - -data Node = Empty - | Shortcut Path (Either Ref ByteString) - | Full (Seq Ref) ByteString - deriving (Show, Eq) - --- the function HP from Appendix C of yellow paper -encodePath :: Path -> Bool -> ByteString -encodePath p isTerminal | even (length p) - = packNibbles $ Nibble flag : Nibble 0 : p - | otherwise - = packNibbles $ Nibble (flag + 1) : p - where flag = if isTerminal then 2 else 0 - -rlpRef :: Ref -> RLP -rlpRef (Hash d) = BS d -rlpRef (Literal n) = rlpNode n - -rlpNode :: Node -> RLP -rlpNode Empty = BS mempty -rlpNode (Shortcut path (Right val)) = List [BS $ encodePath path True, BS val] -rlpNode (Shortcut path (Left ref)) = List [BS $ encodePath path False, rlpRef ref] -rlpNode (Full refs val) = List $ toList (fmap rlpRef refs) <> [BS val] - -type NodeDB = DB ByteString Node - -instance Show (NodeDB Node) where - show = show - -putNode :: Node -> NodeDB Ref -putNode node = - let bytes = rlpencode $ rlpNode node - digest = word256Bytes $ keccak bytes - in if BS.length bytes < 32 - then return $ Literal node - else do - insertDB digest node - return $ Hash digest - -getNode :: Ref -> NodeDB Node -getNode (Hash d) = lookupDB d -getNode (Literal n) = return n - -lookupPath :: Ref -> Path -> NodeDB ByteString -lookupPath root path = getNode root >>= getVal path - -getVal :: Path -> Node -> NodeDB ByteString -getVal _ Empty = return BS.empty -getVal path (Shortcut nodePath ref) = - case (stripPrefix nodePath path, ref) of - (Just [], Right value) -> return value - (Just remaining, Left key) -> lookupPath key remaining - _ -> return BS.empty - -getVal [] (Full _ val) = return val -getVal (p:ps) (Full refs _) = lookupPath (refs `Seq.index` (num p)) ps - -emptyRef :: Ref -emptyRef = Literal Empty - -emptyRefs :: Seq Ref -emptyRefs = Seq.replicate 16 emptyRef - -addPrefix :: Path -> Node -> NodeDB Node -addPrefix _ Empty = return Empty -addPrefix [] node = return node -addPrefix path (Shortcut p v) = return $ Shortcut (path <> p) v -addPrefix path n = Shortcut path . Left <$> putNode n - -insertRef :: Ref -> Path -> ByteString -> NodeDB Ref -insertRef ref p val = do root <- getNode ref - newNode <- if val == BS.empty - then delete root p - else update root p val - putNode newNode - -update :: Node -> Path -> ByteString -> NodeDB Node -update Empty p new = return $ Shortcut p (Right new) -update (Full refs _) [] new = return (Full refs new) -update (Full refs old) (p:ps) new = do - newRef <- insertRef (refs `Seq.index` (num p)) ps new - return $ Full (Seq.update (num p) newRef refs) old -update (Shortcut (o:os) (Right old)) [] new = do - newRef <- insertRef emptyRef os old - return $ Full (Seq.update (num o) newRef emptyRefs) new -update (Shortcut [] (Right old)) (p:ps) new = do - newRef <- insertRef emptyRef ps new - return $ Full (Seq.update (num p) newRef emptyRefs) old -update (Shortcut [] (Right _)) [] new = - return $ Shortcut [] (Right new) -update (Shortcut (o:os) to) (p:ps) new | o == p - = update (Shortcut os to) ps new >>= addPrefix [o] - | otherwise = do - oldRef <- case to of - (Left ref) -> getNode ref >>= addPrefix os >>= putNode - (Right val) -> insertRef emptyRef os val - newRef <- insertRef emptyRef ps new - let refs = Seq.update (num p) newRef $ Seq.update (num o) oldRef emptyRefs - return $ Full refs BS.empty -update (Shortcut (o:os) (Left ref)) [] new = do - newRef <- getNode ref >>= addPrefix os >>= putNode - return $ Full (Seq.update (num o) newRef emptyRefs) new -update (Shortcut cut (Left ref)) ps new = do - newRef <- insertRef ref ps new - return $ Shortcut cut (Left newRef) - -delete :: Node -> Path -> NodeDB Node -delete Empty _ = return Empty -delete (Shortcut [] (Right _)) [] = return Empty -delete n@(Shortcut [] (Right _)) _ = return n -delete (Shortcut [] (Left ref)) p = do node <- getNode ref - delete node p -delete n@(Shortcut _ _) [] = return n -delete n@(Shortcut (o:os) to) (p:ps) | p == o - = delete (Shortcut os to) ps >>= addPrefix [o] - | otherwise - = return n -delete (Full refs _) [] | refs == emptyRefs - = return Empty - | otherwise - = return (Full refs BS.empty) -delete (Full refs val) (p:ps) = do - newRef <- insertRef (refs `Seq.index` (num p)) ps BS.empty - let newRefs = Seq.update (num p) newRef refs - nonEmpties = filter (\(_, ref) -> ref /= emptyRef) $ zip [0..15] $ toList newRefs - case (nonEmpties, BS.null val) of - ([], True) -> return Empty - ([(n, ref)], True) -> getNode ref >>= addPrefix [Nibble n] - _ -> return $ Full newRefs val - -insert :: Ref -> ByteString -> ByteString -> NodeDB Ref -insert ref key = insertRef ref (unpackNibbles key) - -lookupIn :: Ref -> ByteString -> NodeDB ByteString -lookupIn ref bs = lookupPath ref $ unpackNibbles bs - -type Trie = StateT Ref NodeDB - -runTrie :: DB ByteString ByteString a -> Trie a -runTrie = runDB putDB getDB - where - putDB key val = do - ref <- get - newRef <- lift $ insert ref key val - put newRef - getDB key = do - ref <- get - lift $ lookupIn ref key - -type MapDB k v a = StateT (Map.Map k v) Maybe a - -runMapDB :: Ord k => DB k v a -> MapDB k v a -runMapDB = runDB putDB getDB - where - getDB key = do - mmap <- get - lift $ Map.lookup key mmap - putDB key value = do - mmap <- get - let newMap = Map.insert key value mmap - put newMap - - -insertValues :: [(ByteString, ByteString)] -> Maybe Ref -insertValues inputs = - let trie = runTrie $ mapM_ insertPair inputs - mapDB = runMapDB $ runStateT trie (Literal Empty) - result = snd <$> evalStateT mapDB Map.empty - insertPair (key, value) = insertDB key value - in result - -calcRoot :: [(ByteString, ByteString)] -> Maybe ByteString -calcRoot vs = case insertValues vs of - Just (Hash b) -> Just b - Just (Literal n) -> Just $ word256Bytes $ keccak $ rlpencode $ rlpNode n - Nothing -> Nothing diff --git a/src/hevm/src/EVM/Precompiled.hs b/src/hevm/src/EVM/Precompiled.hs deleted file mode 100644 index 2c829e4e8..000000000 --- a/src/hevm/src/EVM/Precompiled.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# Language ForeignFunctionInterface #-} - -module EVM.Precompiled (execute) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS - -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - --- | Opaque representation of the C library's context struct. -data EthjetContext - -foreign import ccall "ethjet_init" - ethjet_init :: IO (Ptr EthjetContext) -foreign import ccall "ðjet_free" - ethjet_free :: FunPtr (Ptr EthjetContext -> IO ()) -foreign import ccall "ethjet" - ethjet - :: Ptr EthjetContext -- initialized context - -> CInt -- operation - -> Ptr CChar -> CInt -- input - -> Ptr CChar -> CInt -- output - -> IO CInt -- 1 if good - --- Lazy evaluation ensures this context is only initialized once, --- and `unsafePerformIO` in such situations is a common pattern. --- --- We use a "foreign pointer" annotated with a finalizer. -globalContext :: ForeignPtr EthjetContext -{-# NOINLINE globalContext #-} -globalContext = - unsafePerformIO $ - ethjet_init >>= newForeignPtr ethjet_free - --- | Run a given precompiled contract using the C library. -execute - :: Int -- ^ The number of the precompiled contract - -> ByteString -- ^ The input buffer - -> Int -- ^ The desired output size - -> Maybe ByteString -- ^ Hopefully, the output buffer -execute contract input outputSize = - - -- This code looks messy because of the pointer handling, - -- but it's actually simple. - -- - -- We use `unsafePerformIO` because the contracts are pure. - - unsafePerformIO . BS.useAsCStringLen input $ - \(inputPtr, inputSize) -> do - outputForeignPtr <- mallocForeignPtrBytes outputSize - withForeignPtr outputForeignPtr $ \outputPtr -> do - status <- - withForeignPtr globalContext $ \contextPtr -> - -- Finally, we can invoke the C library. - ethjet contextPtr (fromIntegral contract) - inputPtr (fromIntegral inputSize) - outputPtr (fromIntegral outputSize) - - case status of - 1 -> Just <$> BS.packCStringLen (outputPtr, outputSize) - _ -> pure Nothing diff --git a/src/hevm/src/EVM/RLP.hs b/src/hevm/src/EVM/RLP.hs deleted file mode 100644 index 4ce2b5cf2..000000000 --- a/src/hevm/src/EVM/RLP.hs +++ /dev/null @@ -1,89 +0,0 @@ -module EVM.RLP where - -import Prelude hiding (drop, head) -import EVM.Types -import Data.Bits (shiftR) -import Data.ByteString (ByteString, drop, head) -import qualified Data.ByteString as BS - -data RLP = BS ByteString | List [RLP] deriving Eq - -instance Show RLP where - show (BS str) = show (ByteStringS str) - show (List list) = show list - -slice :: Int -> Int -> ByteString -> ByteString -slice offset size bs = BS.take size $ BS.drop offset bs - --- helper function returning (the length of the prefix, the length of the content, isList boolean, optimal boolean) -itemInfo :: ByteString -> (Int, Int, Bool, Bool) -itemInfo bs | bs == mempty = (0, 0, False, False) - | otherwise = case head bs of - x | 0 <= x && x < 128 -> (0, 1, False, True) -- directly encoded byte - x | 128 <= x && x < 184 -> (1, num x - 128, False, (BS.length bs /= 2) || (127 < (head $ drop 1 bs))) -- short string - x | 184 <= x && x < 192 -> (1 + pre, len, False, (len > 55) && head (drop 1 bs) /= 0) -- long string - where pre = num $ x - 183 - len = num $ word $ slice 1 pre bs - x | 192 <= x && x < 248 -> (1, num $ x - 192, True, True) -- short list - x -> (1 + pre, len, True, (len > 55) && head (drop 1 bs) /= 0) -- long list - where pre = num $ x - 247 - len = num $ word $ slice 1 pre bs - -rlpdecode :: ByteString -> Maybe RLP -rlpdecode bs | optimal && pre + len == BS.length bs = if isList - then do - items <- mapM - (\(s, e) -> rlpdecode $ slice s e content) $ - rlplengths content 0 len - Just (List items) - else Just (BS content) - | otherwise = Nothing - where (pre, len, isList, optimal) = itemInfo bs - content = drop pre bs - -rlplengths :: ByteString -> Int -> Int -> [(Int,Int)] -rlplengths bs acc top | acc < top = let (pre, len, _, _) = itemInfo bs - in (acc, pre + len) : rlplengths (drop (pre + len) bs) (acc + pre + len) top - | otherwise = [] - -rlpencode :: RLP -> ByteString -rlpencode (BS bs) = if BS.length bs == 1 && head bs < 128 then bs - else encodeLen 128 bs -rlpencode (List items) = encodeLen 192 (mconcat $ map rlpencode items) - -encodeLen :: Int -> ByteString -> ByteString -encodeLen offset bs | BS.length bs <= 55 = prefix (BS.length bs) <> bs - | otherwise = prefix lenLen <> lenBytes <> bs - where - lenBytes = asBE $ BS.length bs - prefix n = BS.singleton $ num $ offset + n - lenLen = BS.length lenBytes + 55 - -rlpList :: [RLP] -> ByteString -rlpList n = rlpencode $ List n - -octets :: W256 -> ByteString -octets x = - BS.pack $ dropWhile (== 0) [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..31]] - -octetsFull :: Int -> W256 -> ByteString -octetsFull n x = - BS.pack $ [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..n]] - -octets160 :: Addr -> ByteString -octets160 x = - BS.pack $ dropWhile (== 0) [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..19]] - -rlpWord256 :: W256 -> RLP -rlpWord256 0 = BS mempty -rlpWord256 n = BS $ octets n - -rlpWordFull :: W256 -> RLP -rlpWordFull = BS . octetsFull 31 - -rlpAddrFull :: Addr -> RLP -rlpAddrFull = BS . octetsFull 19 . num - -rlpWord160 :: Addr -> RLP -rlpWord160 0 = BS mempty -rlpWord160 n = BS $ octets160 n diff --git a/src/hevm/src/EVM/Solidity.hs b/src/hevm/src/EVM/Solidity.hs deleted file mode 100644 index b7d0f36bf..000000000 --- a/src/hevm/src/EVM/Solidity.hs +++ /dev/null @@ -1,738 +0,0 @@ -{-# Language DeriveAnyClass #-} -{-# Language DataKinds #-} -{-# Language StrictData #-} -{-# Language TemplateHaskell #-} -{-# Language OverloadedStrings #-} -{-# Language QuasiQuotes #-} - -module EVM.Solidity - ( solidity - , solcRuntime - , solidity' - , yul' - , yul - , yulRuntime - , JumpType (..) - , SolcContract (..) - , StorageItem (..) - , SourceCache (..) - , SrcMap (..) - , CodeType (..) - , Method (..) - , SlotType (..) - , Reference(..) - , Mutability(..) - , methodName - , methodSignature - , methodInputs - , methodOutput - , methodMutability - , abiMap - , eventMap - , errorMap - , storageLayout - , contractName - , constructorInputs - , creationCode - , functionAbi - , makeSrcMaps - , readSolc - , readJSON - , readStdJSON - , readCombinedJSON - , runtimeCode - , runtimeCodehash - , creationCodehash - , runtimeSrcmap - , creationSrcmap - , sourceFiles - , sourceLines - , sourceAsts - , stripBytecodeMetadata - , stripBytecodeMetadataSym - , signature - , solc - , Language(..) - , stdjson - , parseMethodInput - , lineSubrange - , astIdMap - , astSrcMap - , containsLinkerHole -) where - -import EVM.ABI -import EVM.Types -import Data.SBV - -import Control.Applicative -import Control.Monad -import Control.Lens hiding (Indexed, (.=)) -import qualified Data.String.Here as Here -import Data.Aeson hiding (json) -import Data.Aeson.Types -import Data.Aeson.Lens -import Data.Scientific -import Data.ByteString (ByteString) -import Data.ByteString.Lazy (toStrict) -import Data.Char (isDigit) -import Data.Foldable -import Data.Map.Strict (Map) -import Data.Maybe -import Data.List.NonEmpty (NonEmpty) -import qualified Data.List.NonEmpty as NonEmpty -import Data.Semigroup -import Data.Sequence (Seq) -import Data.Text (Text, pack, intercalate) -import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Data.Text.IO (readFile, writeFile) -import Data.Vector (Vector) -import GHC.Generics (Generic) -import Prelude hiding (readFile, writeFile) -import System.IO hiding (readFile, writeFile) -import System.IO.Temp -import System.Process -import Text.Read (readMaybe) - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as BS16 -import qualified Data.HashMap.Strict as HMap -import qualified Data.Map.Strict as Map -import qualified Data.Text as Text -import qualified Data.Vector as Vector -import Data.List (sort, isPrefixOf, isInfixOf, elemIndex, tails, findIndex) - -data StorageItem = StorageItem { - _type :: SlotType, - _offset :: Int, - _slot :: Int - } deriving (Show, Eq) - -data SlotType - -- Note that mapping keys can only be elementary; - -- that excludes arrays, contracts, and mappings. - = StorageMapping (NonEmpty AbiType) AbiType - | StorageValue AbiType --- | StorageArray AbiType - deriving Eq - -instance Show SlotType where - show (StorageValue t) = show t - show (StorageMapping s t) = - foldr - (\x y -> - "mapping(" - <> show x - <> " => " - <> y - <> ")") - (show t) s - -instance Read SlotType where - readsPrec _ ('m':'a':'p':'p':'i':'n':'g':'(':s) = - let (lhs:rhs) = Text.splitOn " => " (pack s) - first = fromJust $ parseTypeName mempty lhs - target = fromJust $ parseTypeName mempty (Text.replace ")" "" (last rhs)) - rest = fmap (fromJust . (parseTypeName mempty . (Text.replace "mapping(" ""))) (take (length rhs - 1) rhs) - in [(StorageMapping (first NonEmpty.:| rest) target, "")] - readsPrec _ s = [(StorageValue $ fromMaybe (error "could not parse storage item") (parseTypeName mempty (pack s)),"")] - -data SolcContract = SolcContract - { _runtimeCodehash :: W256 - , _creationCodehash :: W256 - , _runtimeCode :: ByteString - , _creationCode :: ByteString - , _contractName :: Text - , _constructorInputs :: [(Text, AbiType)] - , _abiMap :: Map Word32 Method - , _eventMap :: Map W256 Event - , _errorMap :: Map W256 SolError - , _immutableReferences :: Map W256 [Reference] - , _storageLayout :: Maybe (Map Text StorageItem) - , _runtimeSrcmap :: Seq SrcMap - , _creationSrcmap :: Seq SrcMap - } deriving (Show, Eq, Generic) - -data Method = Method - { _methodOutput :: [(Text, AbiType)] - , _methodInputs :: [(Text, AbiType)] - , _methodName :: Text - , _methodSignature :: Text - , _methodMutability :: Mutability - } deriving (Show, Eq, Ord, Generic) - -data Mutability - = Pure -- ^ specified to not read blockchain state - | View -- ^ specified to not modify the blockchain state - | NonPayable -- ^ function does not accept Ether - the default - | Payable -- ^ function accepts Ether - deriving (Show, Eq, Ord, Generic) - -data SourceCache = SourceCache - { _sourceFiles :: [(Text, ByteString)] - , _sourceLines :: [(Vector ByteString)] - , _sourceAsts :: Map Text Value - } deriving (Show, Eq, Generic) - -data Reference = Reference - { _refStart :: Int, - _refLength :: Int - } deriving (Show, Eq) - -instance FromJSON Reference where - parseJSON (Object v) = Reference - <$> v .: "start" - <*> v .: "length" - parseJSON invalid = - typeMismatch "Transaction" invalid - -instance Semigroup SourceCache where - _ <> _ = error "lol" - -instance Monoid SourceCache where - mempty = SourceCache mempty mempty mempty - -data JumpType = JumpInto | JumpFrom | JumpRegular - deriving (Show, Eq, Ord, Generic) - -data SrcMap = SM { - srcMapOffset :: {-# UNPACK #-} Int, - srcMapLength :: {-# UNPACK #-} Int, - srcMapFile :: {-# UNPACK #-} Int, - srcMapJump :: JumpType, - srcMapModifierDepth :: {-# UNPACK #-} Int -} deriving (Show, Eq, Ord, Generic) - -data SrcMapParseState - = F1 String Int - | F2 Int String Int - | F3 Int Int String Int - | F4 Int Int Int (Maybe JumpType) - | F5 Int Int Int JumpType String - | Fe - deriving Show - -data CodeType = Creation | Runtime - deriving (Show, Eq, Ord) - -makeLenses ''SolcContract -makeLenses ''SourceCache -makeLenses ''Method - --- Obscure but efficient parser for the Solidity sourcemap format. -makeSrcMaps :: Text -> Maybe (Seq SrcMap) -makeSrcMaps = (\case (_, Fe, _) -> Nothing; x -> Just (done x)) - . Text.foldl' (flip go) (mempty, F1 [] 1, SM 0 0 0 JumpRegular 0) - where - done (xs, s, p) = let (xs', _, _) = go ';' (xs, s, p) in xs' - readR = read . reverse - - go :: Char -> (Seq SrcMap, SrcMapParseState, SrcMap) -> (Seq SrcMap, SrcMapParseState, SrcMap) - go ':' (xs, F1 [] _, p@(SM a _ _ _ _)) = (xs, F2 a [] 1, p) - go ':' (xs, F1 ds k, p) = (xs, F2 (k * (readR ds)) [] 1, p) - go '-' (xs, F1 [] _, p) = (xs, F1 [] (-1), p) - go d (xs, F1 ds k, p) | isDigit d = (xs, F1 (d : ds) k, p) - go ';' (xs, F1 [] k, p) = (xs |> p, F1 [] k, p) - go ';' (xs, F1 ds k, SM _ b c d e) = let p' = SM (k * (readR ds)) b c d e in (xs |> p', F1 [] 1, p') - - go '-' (xs, F2 a [] _, p) = (xs, F2 a [] (-1), p) - go d (xs, F2 a ds k, p) | isDigit d = (xs, F2 a (d : ds) k, p) - go ':' (xs, F2 a [] _, p@(SM _ b _ _ _)) = (xs, F3 a b [] 1, p) - go ':' (xs, F2 a ds k, p) = (xs, F3 a (k * (readR ds)) [] 1, p) - go ';' (xs, F2 a [] _, SM _ b c d e) = let p' = SM a b c d e in (xs |> p', F1 [] 1, p') - go ';' (xs, F2 a ds k, SM _ _ c d e) = let p' = SM a (k * (readR ds)) c d e in - (xs |> p', F1 [] 1, p') - - go d (xs, F3 a b ds k, p) | isDigit d = (xs, F3 a b (d : ds) k, p) - go '-' (xs, F3 a b [] _, p) = (xs, F3 a b [] (-1), p) - go ':' (xs, F3 a b [] _, p@(SM _ _ c _ _)) = (xs, F4 a b c Nothing, p) - go ':' (xs, F3 a b ds k, p) = (xs, F4 a b (k * (readR ds)) Nothing, p) - go ';' (xs, F3 a b [] _, SM _ _ c d e) = let p' = SM a b c d e in (xs |> p', F1 [] 1, p') - go ';' (xs, F3 a b ds k, SM _ _ _ d e) = let p' = SM a b (k * (readR ds)) d e in - (xs |> p', F1 [] 1, p') - - go 'i' (xs, F4 a b c Nothing, p) = (xs, F4 a b c (Just JumpInto), p) - go 'o' (xs, F4 a b c Nothing, p) = (xs, F4 a b c (Just JumpFrom), p) - go '-' (xs, F4 a b c Nothing, p) = (xs, F4 a b c (Just JumpRegular), p) - go ':' (xs, F4 a b c (Just d), p) = (xs, F5 a b c d [], p) - go ':' (xs, F4 a b c _, p@(SM _ _ _ d _)) = (xs, F5 a b c d [], p) - go ';' (xs, F4 a b c _, SM _ _ _ d e) = let p' = SM a b c d e in - (xs |> p', F1 [] 1, p') - - go d (xs, F5 a b c j ds, p) | isDigit d = (xs, F5 a b c j (d : ds), p) - go ';' (xs, F5 a b c j [], _) = let p' = SM a b c j (-1) in -- solc <0.6 - (xs |> p', F1 [] 1, p') - go ';' (xs, F5 a b c j ds, _) = let p' = SM a b c j (readR ds) in -- solc >=0.6 - (xs |> p', F1 [] 1, p') - - go c (xs, state, p) = (xs, error ("srcmap: y u " ++ show c ++ " in state" ++ show state ++ "?!?"), p) - -makeSourceCache :: [(Text, Maybe ByteString)] -> Map Text Value -> IO SourceCache -makeSourceCache paths asts = do - let f (_, Just content) = return content - f (fp, Nothing) = BS.readFile $ Text.unpack fp - xs <- mapM f paths - return $! SourceCache - { _sourceFiles = zip (fst <$> paths) xs - , _sourceLines = map (Vector.fromList . BS.split 0xa) xs - , _sourceAsts = asts - } - -lineSubrange :: - Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int) -lineSubrange xs (s1, n1) i = - let - ks = Vector.map (\x -> 1 + BS.length x) xs - s2 = Vector.sum (Vector.take i ks) - n2 = ks Vector.! i - in - if s1 + n1 < s2 || s1 > s2 + n2 - then Nothing - else Just (s1 - s2, min (s2 + n2 - s1) n1) - -readSolc :: FilePath -> IO (Maybe (Map Text SolcContract, SourceCache)) -readSolc fp = - (readJSON <$> readFile fp) >>= - \case - Nothing -> return Nothing - Just (contracts, asts, sources) -> do - sourceCache <- makeSourceCache sources asts - return $! Just (contracts, sourceCache) - -yul :: Text -> Text -> IO (Maybe ByteString) -yul contract src = do - (json, path) <- yul' src - let (Just f) = json ^?! key "contracts" ^? key path - (Just c) = f ^? key (if Text.null contract then "object" else contract) - bytecode = c ^?! key "evm" ^?! key "bytecode" ^?! key "object" . _String - pure $ toCode <$> (Just bytecode) - -yulRuntime :: Text -> Text -> IO (Maybe ByteString) -yulRuntime contract src = do - (json, path) <- yul' src - let (Just f) = json ^?! key "contracts" ^? key path - (Just c) = f ^? key (if Text.null contract then "object" else contract) - bytecode = c ^?! key "evm" ^?! key "deployedBytecode" ^?! key "object" . _String - pure $ toCode <$> (Just bytecode) - -solidity :: Text -> Text -> IO (Maybe ByteString) -solidity contract src = do - (json, path) <- solidity' src - let Just (sol, _, _) = readJSON json - return (sol ^? ix (path <> ":" <> contract) . creationCode) - -solcRuntime :: Text -> Text -> IO (Maybe ByteString) -solcRuntime contract src = do - (json, path) <- solidity' src - let Just (sol, _, _) = readJSON json - return (sol ^? ix (path <> ":" <> contract) . runtimeCode) - -functionAbi :: Text -> IO Method -functionAbi f = do - (json, path) <- solidity' ("contract ABI { function " <> f <> " public {}}") - let Just (sol, _, _) = readJSON json - case Map.toList $ sol ^?! ix (path <> ":ABI") . abiMap of - [(_,b)] -> return b - _ -> error "hevm internal error: unexpected abi format" - -force :: String -> Maybe a -> a -force s = fromMaybe (error s) - -readJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)]) -readJSON json = case json ^? key "sourceList" of - Nothing -> readStdJSON json - _ -> readCombinedJSON json - --- deprecate me soon -readCombinedJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)]) -readCombinedJSON json = do - contracts <- f <$> (json ^? key "contracts" . _Object) - sources <- toList . fmap (view _String) <$> json ^? key "sourceList" . _Array - return (contracts, Map.fromList (HMap.toList asts), [ (x, Nothing) | x <- sources]) - where - asts = fromMaybe (error "JSON lacks abstract syntax trees.") (json ^? key "sources" . _Object) - f x = Map.fromList . HMap.toList $ HMap.mapWithKey g x - g s x = - let - theRuntimeCode = toCode (x ^?! key "bin-runtime" . _String) - theCreationCode = toCode (x ^?! key "bin" . _String) - abis = toList $ case (x ^?! key "abi") ^? _Array of - Just v -> v -- solc >= 0.8 - Nothing -> (x ^?! key "abi" . _String) ^?! _Array -- solc < 0.8 - in SolcContract { - _runtimeCode = theRuntimeCode, - _creationCode = theCreationCode, - _runtimeCodehash = keccak (stripBytecodeMetadata theRuntimeCode), - _creationCodehash = keccak (stripBytecodeMetadata theCreationCode), - _runtimeSrcmap = force "internal error: srcmap-runtime" (makeSrcMaps (x ^?! key "srcmap-runtime" . _String)), - _creationSrcmap = force "internal error: srcmap" (makeSrcMaps (x ^?! key "srcmap" . _String)), - _contractName = s, - _constructorInputs = mkConstructor abis, - _abiMap = mkAbiMap abis, - _eventMap = mkEventMap abis, - _errorMap = mkErrorMap abis, - _storageLayout = mkStorageLayout $ x ^? key "storage-layout", - _immutableReferences = mempty -- TODO: deprecate combined-json - } - -readStdJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)]) -readStdJSON json = do - contracts <- json ^? key "contracts" ._Object - -- TODO: support the general case of "urls" and "content" in the standard json - sources <- json ^? key "sources" . _Object - let asts = force "JSON lacks abstract syntax trees." . preview (key "ast") <$> sources - contractMap = f contracts - contents src = (src, encodeUtf8 <$> HMap.lookup src (mconcat $ Map.elems $ snd <$> contractMap)) - return (fst <$> contractMap, Map.fromList (HMap.toList asts), contents <$> (sort $ HMap.keys sources)) - where - f :: (AsValue s) => HMap.HashMap Text s -> (Map Text (SolcContract, (HMap.HashMap Text Text))) - f x = Map.fromList . (concatMap g) . HMap.toList $ x - g (s, x) = h s <$> HMap.toList (view _Object x) - h :: Text -> (Text, Value) -> (Text, (SolcContract, HMap.HashMap Text Text)) - h s (c, x) = - let - evmstuff = x ^?! key "evm" - runtime = evmstuff ^?! key "deployedBytecode" - creation = evmstuff ^?! key "bytecode" - theRuntimeCode = toCode $ fromMaybe "" $ runtime ^? key "object" . _String - theCreationCode = toCode $ fromMaybe "" $ creation ^? key "object" . _String - srcContents :: Maybe (HMap.HashMap Text Text) - srcContents = do metadata <- x ^? key "metadata" . _String - srcs <- metadata ^? key "sources" . _Object - return $ (view (key "content" . _String)) <$> (HMap.filter (isJust . preview (key "content")) srcs) - abis = force ("abi key not found in " <> show x) $ - toList <$> x ^? key "abi" . _Array - in (s <> ":" <> c, (SolcContract { - _runtimeCode = theRuntimeCode, - _creationCode = theCreationCode, - _runtimeCodehash = keccak (stripBytecodeMetadata theRuntimeCode), - _creationCodehash = keccak (stripBytecodeMetadata theCreationCode), - _runtimeSrcmap = force "internal error: srcmap-runtime" (makeSrcMaps (runtime ^?! key "sourceMap" . _String)), - _creationSrcmap = force "internal error: srcmap" (makeSrcMaps (creation ^?! key "sourceMap" . _String)), - _contractName = s <> ":" <> c, - _constructorInputs = mkConstructor abis, - _abiMap = mkAbiMap abis, - _eventMap = mkEventMap abis, - _errorMap = mkErrorMap abis, - _storageLayout = mkStorageLayout $ x ^? key "storageLayout", - _immutableReferences = fromMaybe mempty $ - do x' <- runtime ^? key "immutableReferences" - case fromJSON x' of - Success a -> return a - _ -> Nothing - }, fromMaybe mempty srcContents)) - -mkAbiMap :: [Value] -> Map Word32 Method -mkAbiMap abis = Map.fromList $ - let - relevant = filter (\y -> "function" == y ^?! key "type" . _String) abis - f abi = - (abiKeccak (encodeUtf8 (signature abi)), - Method { _methodName = abi ^?! key "name" . _String - , _methodSignature = signature abi - , _methodInputs = map parseMethodInput - (toList (abi ^?! key "inputs" . _Array)) - , _methodOutput = map parseMethodInput - (toList (abi ^?! key "outputs" . _Array)) - , _methodMutability = parseMutability - (abi ^?! key "stateMutability" . _String) - }) - in f <$> relevant - -mkEventMap :: [Value] -> Map W256 Event -mkEventMap abis = Map.fromList $ - let - relevant = filter (\y -> "event" == y ^?! key "type" . _String) abis - f abi = - ( keccak (encodeUtf8 (signature abi)) - , Event - (abi ^?! key "name" . _String) - (case abi ^?! key "anonymous" . _Bool of - True -> Anonymous - False -> NotAnonymous) - (map (\y -> - ( y ^?! key "name" . _String - , force "internal error: type" (parseTypeName' y) - , if y ^?! key "indexed" . _Bool - then Indexed - else NotIndexed - )) - (toList $ abi ^?! key "inputs" . _Array)) - ) - in f <$> relevant - -mkErrorMap :: [Value] -> Map W256 SolError -mkErrorMap abis = Map.fromList $ - let - relevant = filter (\y -> "error" == y ^?! key "type" . _String) abis - f abi = - ( stripKeccak $ keccak (encodeUtf8 (signature abi)) - , SolError - (abi ^?! key "name" . _String) - (map (\y -> ( force "internal error: type" (parseTypeName' y))) - (toList $ abi ^?! key "inputs" . _Array)) - ) - in f <$> relevant - where - stripKeccak :: W256 -> W256 - stripKeccak = read . take 10 . show - -mkConstructor :: [Value] -> [(Text, AbiType)] -mkConstructor abis = - let - isConstructor y = - "constructor" == y ^?! key "type" . _String - in - case filter isConstructor abis of - [abi] -> map parseMethodInput (toList (abi ^?! key "inputs" . _Array)) - [] -> [] -- default constructor has zero inputs - _ -> error "strange: contract has multiple constructors" - -mkStorageLayout :: Maybe Value -> Maybe (Map Text StorageItem) -mkStorageLayout Nothing = Nothing -mkStorageLayout (Just json) = do - items <- json ^? key "storage" . _Array - types <- json ^? key "types" - fmap Map.fromList (forM (Vector.toList items) $ \item -> - do name <- item ^? key "label" . _String - offset <- item ^? key "offset" . _Number >>= toBoundedInteger - slot <- item ^? key "slot" . _String - typ <- item ^? key "type" . _String - slotType <- types ^?! key typ ^? key "label" . _String - return (name, StorageItem (read $ Text.unpack slotType) offset (read $ Text.unpack slot))) - -signature :: AsValue s => s -> Text -signature abi = - case abi ^?! key "type" of - "fallback" -> "" - _ -> - fold [ - fromMaybe "" (abi ^? key "name" . _String), "(", - intercalate "," - (map (\x -> x ^?! key "type" . _String) - (toList $ abi ^?! key "inputs" . _Array)), - ")" - ] - --- Helper function to convert the fields to the desired type -parseTypeName' :: AsValue s => s -> Maybe AbiType -parseTypeName' x = - parseTypeName - (fromMaybe mempty $ x ^? key "components" . _Array . to parseComponents) - (x ^?! key "type" . _String) - where parseComponents = fmap $ snd . parseMethodInput - -parseMutability :: Text -> Mutability -parseMutability "view" = View -parseMutability "pure" = Pure -parseMutability "nonpayable" = NonPayable -parseMutability "payable" = Payable -parseMutability _ = error "unknown function mutability" - --- This actually can also parse a method output! :O -parseMethodInput :: AsValue s => s -> (Text, AbiType) -parseMethodInput x = - ( x ^?! key "name" . _String - , force "internal error: method type" (parseTypeName' x) - ) - -containsLinkerHole :: Text -> Bool -containsLinkerHole = regexMatches "__\\$[a-z0-9]{34}\\$__" - -toCode :: Text -> ByteString -toCode t = case BS16.decode (encodeUtf8 t) of - Right d -> d - Left e -> if containsLinkerHole t - then error "unlinked libraries detected in bytecode" - else error e - -solidity' :: Text -> IO (Text, Text) -solidity' src = withSystemTempFile "hevm.sol" $ \path handle -> do - hClose handle - writeFile path ("//SPDX-License-Identifier: UNLICENSED\n" <> "pragma solidity ^0.8.6;\n" <> src) - writeFile (path <> ".json") - [Here.i| - { - "language": "Solidity", - "sources": { - ${path}: { - "urls": [ - ${path} - ] - } - }, - "settings": { - "outputSelection": { - "*": { - "*": [ - "metadata", - "evm.bytecode", - "evm.deployedBytecode", - "abi", - "storageLayout", - "evm.bytecode.sourceMap", - "evm.bytecode.linkReferences", - "evm.bytecode.generatedSources", - "evm.deployedBytecode.sourceMap", - "evm.deployedBytecode.linkReferences", - "evm.deployedBytecode.generatedSources" - ], - "": [ - "ast" - ] - } - } - } - } - |] - x <- pack <$> - readProcess - "solc" - ["--allow-paths", path, "--standard-json", (path <> ".json")] - "" - return (x, pack path) - -yul' :: Text -> IO (Text, Text) -yul' src = withSystemTempFile "hevm.yul" $ \path handle -> do - hClose handle - writeFile path src - writeFile (path <> ".json") - [Here.i| - { - "language": "Yul", - "sources": { ${path}: { "urls": [ ${path} ] } }, - "settings": { "outputSelection": { "*": { "*": ["*"], "": [ "*" ] } } } - } - |] - x <- pack <$> - readProcess - "solc" - ["--allow-paths", path, "--standard-json", (path <> ".json")] - "" - return (x, pack path) - -solc :: Language -> Text -> IO Text -solc lang src = - withSystemTempFile "hevm.sol" $ \path handle -> do - hClose handle - writeFile path (stdjson lang src) - Text.pack <$> readProcess - "solc" - ["--standard-json", path] - "" - -data Language = Solidity | Yul - deriving (Show) - -data StandardJSON = StandardJSON Language Text --- more options later perhaps - -instance ToJSON StandardJSON where - toJSON (StandardJSON lang src) = - object [ "language" .= show lang - , "sources" .= object ["hevm.sol" .= - object ["content" .= src]] - , "settings" .= - object [ "outputSelection" .= - object ["*" .= - object ["*" .= (toJSON - ["metadata" :: String, - "evm.bytecode", - "evm.deployedBytecode", - "abi", - "storageLayout", - "evm.bytecode.sourceMap", - "evm.bytecode.linkReferences", - "evm.bytecode.generatedSources", - "evm.deployedBytecode.sourceMap", - "evm.deployedBytecode.linkReferences", - "evm.deployedBytecode.generatedSources", - "evm.deployedBytecode.immutableReferences" - ]), - "" .= (toJSON ["ast" :: String]) - ] - ] - ] - ] - -stdjson :: Language -> Text -> Text -stdjson lang src = decodeUtf8 $ toStrict $ encode $ StandardJSON lang src - --- | When doing CREATE and passing constructor arguments, Solidity loads --- the argument data via the creation bytecode, since there is no "calldata" --- for CREATE. --- --- This interferes with our ability to look up the current contract by --- codehash, so we must somehow strip away this extra suffix. Luckily --- we can detect the end of the actual bytecode by looking for the --- "metadata hash". (Not 100% correct, but works in practice.) --- --- Actually, we strip away the entire BZZR suffix too, because as long --- as the codehash matches otherwise, we don't care if there is some --- difference there. -stripBytecodeMetadata :: ByteString -> ByteString -stripBytecodeMetadata bs = - let stripCandidates = flip BS.breakSubstring bs <$> knownBzzrPrefixes in - case find ((/= mempty) . snd) stripCandidates of - Nothing -> bs - Just (b, _) -> b - -stripBytecodeMetadataSym :: [SWord 8] -> [SWord 8] -stripBytecodeMetadataSym b = - let - concretes :: [Maybe Word8] - concretes = (fmap fromSized) . unliteral <$> b - bzzrs :: [[Maybe Word8]] - bzzrs = fmap (Just) . BS.unpack <$> knownBzzrPrefixes - candidates = (flip Data.List.isInfixOf concretes) <$> bzzrs - in case elemIndex True candidates of - Nothing -> b - Just i -> let Just ind = infixIndex (bzzrs !! i) concretes - in take ind b - -infixIndex :: (Eq a) => [a] -> [a] -> Maybe Int -infixIndex needle haystack = findIndex (isPrefixOf needle) (tails haystack) - -knownBzzrPrefixes :: [ByteString] -knownBzzrPrefixes = [ - -- a1 65 "bzzr0" 0x58 0x20 (solc <= 0.5.8) - BS.pack [0xa1, 0x65, 98, 122, 122, 114, 48, 0x58, 0x20], - -- a2 65 "bzzr0" 0x58 0x20 (solc >= 0.5.9) - BS.pack [0xa2, 0x65, 98, 122, 122, 114, 48, 0x58, 0x20], - -- a2 65 "bzzr1" 0x58 0x20 (solc >= 0.5.11) - BS.pack [0xa2, 0x65, 98, 122, 122, 114, 49, 0x58, 0x20], - -- a2 64 "ipfs" 0x58 0x22 (solc >= 0.6.0) - BS.pack [0xa2, 0x64, 0x69, 0x70, 0x66, 0x73, 0x58, 0x22] - ] - --- | Every node in the AST has an ID, and other nodes reference those --- IDs. This function recurses through the tree looking for objects --- with the "id" key and makes a big map from ID to value. -astIdMap :: Foldable f => f Value -> Map Int Value -astIdMap = foldMap f - where - f :: Value -> Map Int Value - f (Array x) = foldMap f x - f v@(Object x) = - let t = foldMap f (HMap.elems x) - in case HMap.lookup "id" x of - Nothing -> t - Just (Number i) -> t <> Map.singleton (round i) v - Just _ -> t - f _ = mempty - -astSrcMap :: Map Int Value -> (SrcMap -> Maybe Value) -astSrcMap astIds = - \(SM i n f _ _) -> Map.lookup (i, n, f) tmp - where - tmp :: Map (Int, Int, Int) Value - tmp = - Map.fromList - . mapMaybe - (\v -> do - src <- preview (key "src" . _String) v - [i, n, f] <- mapM (readMaybe . Text.unpack) (Text.split (== ':') src) - return ((i, n, f), v) - ) - . Map.elems - $ astIds diff --git a/src/hevm/src/EVM/Stepper.hs b/src/hevm/src/EVM/Stepper.hs deleted file mode 100644 index c6965029f..000000000 --- a/src/hevm/src/EVM/Stepper.hs +++ /dev/null @@ -1,150 +0,0 @@ -{-# Language GADTs #-} -{-# Language DataKinds #-} - -module EVM.Stepper - ( Action (..) - , Stepper - , exec - , execFully - , run - , runFully - , wait - , ask - , evm - , evmIO - , entering - , enter - , interpret - ) -where - --- This module is an abstract definition of EVM steppers. --- Steppers can be run as TTY debuggers or as CLI test runners. --- --- The implementation uses the operational monad pattern --- as the framework for monadic interpretation. --- --- Note: this is a sketch of a work in progress! - -import Prelude hiding (fail) - -import Control.Monad.Operational (Program, singleton, view, ProgramViewT(..), ProgramView) -import Control.Monad.State.Strict (runState, liftIO, StateT) -import qualified Control.Monad.State.Class as State -import qualified EVM.Exec -import Data.Text (Text) -import EVM.Types (Buffer) - -import EVM (EVM, VM, VMResult (VMFailure, VMSuccess), Error (Query, Choose), Query, Choose) -import qualified EVM - -import qualified EVM.Fetch as Fetch - --- | The instruction type of the operational monad -data Action a where - - -- | Keep executing until an intermediate result is reached - Exec :: Action VMResult - - -- | Keep executing until an intermediate state is reached - Run :: Action VM - - -- | Wait for a query to be resolved - Wait :: Query -> Action () - - -- | Multiple things can happen - Ask :: Choose -> Action () - - -- | Embed a VM state transformation - EVM :: EVM a -> Action a - - -- | Perform an IO action - IOAct :: StateT VM IO a -> Action a -- they should all just be this? - --- | Type alias for an operational monad of @Action@ -type Stepper a = Program Action a - --- Singleton actions - -exec :: Stepper VMResult -exec = singleton Exec - -run :: Stepper VM -run = singleton Run - -wait :: Query -> Stepper () -wait = singleton . Wait - -ask :: Choose -> Stepper () -ask = singleton . Ask - -evm :: EVM a -> Stepper a -evm = singleton . EVM - -evmIO :: StateT VM IO a -> Stepper a -evmIO = singleton . IOAct - --- | Run the VM until final result, resolving all queries -execFully :: Stepper (Either Error Buffer) -execFully = - exec >>= \case - VMFailure (Query q) -> - wait q >> execFully - VMFailure (Choose q) -> - ask q >> execFully - VMFailure x -> - pure (Left x) - VMSuccess x -> - pure (Right x) - --- | Run the VM until its final state -runFully :: Stepper EVM.VM -runFully = do - vm <- run - case EVM._result vm of - Nothing -> error "should not occur" - Just (VMFailure (Query q)) -> - wait q >> runFully - Just (VMFailure (Choose q)) -> - ask q >> runFully - Just _ -> - pure vm - -entering :: Text -> Stepper a -> Stepper a -entering t stepper = do - evm (EVM.pushTrace (EVM.EntryTrace t)) - x <- stepper - evm EVM.popTrace - pure x - -enter :: Text -> Stepper () -enter t = evm (EVM.pushTrace (EVM.EntryTrace t)) - -interpret :: Fetch.Fetcher -> Stepper a -> StateT VM IO a -interpret fetcher = - eval . view - - where - eval - :: ProgramView Action a - -> StateT VM IO a - - eval (Return x) = - pure x - - eval (action :>>= k) = - case action of - Exec -> - EVM.Exec.exec >>= interpret fetcher . k - Run -> - EVM.Exec.run >>= interpret fetcher . k - Wait q -> - do m <- liftIO (fetcher q) - State.state (runState m) >> interpret fetcher (k ()) - Ask _ -> - error "cannot make choices with this interpreter" - IOAct m -> - do m >>= interpret fetcher . k - EVM m -> do - r <- State.state (runState m) - interpret fetcher (k r) diff --git a/src/hevm/src/EVM/StorageLayout.hs b/src/hevm/src/EVM/StorageLayout.hs deleted file mode 100644 index 892249601..000000000 --- a/src/hevm/src/EVM/StorageLayout.hs +++ /dev/null @@ -1,154 +0,0 @@ -module EVM.StorageLayout where - --- Figures out the layout of storage slots for Solidity contracts. - -import EVM.Dapp (DappInfo, dappAstSrcMap, dappAstIdMap) -import EVM.Solidity (SolcContract, creationSrcmap, SlotType(..)) -import EVM.ABI (AbiType (..), parseTypeName) - -import Data.Aeson (Value (..)) -import Data.Aeson.Lens - -import Control.Lens - -import Data.Text (Text, unpack, pack, words) - -import Data.Foldable (toList) -import Data.Maybe (fromMaybe, isJust) -import qualified Data.List.NonEmpty as NonEmpty - -import qualified Data.Sequence as Seq - -import Prelude hiding (words) - --- A contract has all the slots of its inherited contracts. --- --- The slot order is determined by the inheritance linearization order, --- so we first have to calculate that. --- --- This information is available in the abstract syntax tree. - -findContractDefinition :: DappInfo -> SolcContract -> Maybe Value -findContractDefinition dapp solc = - -- The first source mapping in the contract's creation code - -- corresponds to the source field of the contract definition. - case Seq.viewl (view creationSrcmap solc) of - firstSrcMap Seq.:< _ -> - (view dappAstSrcMap dapp) firstSrcMap - _ -> - Nothing - -storageLayout :: DappInfo -> SolcContract -> [Text] -storageLayout dapp solc = - let - root :: Value - root = - fromMaybe Null - (findContractDefinition dapp solc) - in - case preview ( key "attributes" - . key "linearizedBaseContracts" - . _Array - ) root of - Nothing -> - [] - Just ((reverse . toList) -> linearizedBaseContracts) -> - flip concatMap linearizedBaseContracts - (\case - Number i -> fromMaybe (error "malformed AST JSON") $ - storageVariablesForContract =<< - preview (dappAstIdMap . ix (floor i)) dapp - _ -> - error "malformed AST JSON") - -storageVariablesForContract :: Value -> Maybe [Text] -storageVariablesForContract node = do - name <- preview (ix "attributes" . key "name" . _String) node - vars <- - fmap - (filter isStorageVariableDeclaration . toList) - (preview (ix "children" . _Array) node) - - pure . flip map vars $ - \x -> - case preview (key "attributes" . key "name" . _String) x of - Just variableName -> - mconcat - [ variableName - , " (", name, ")" - , "\n", " Type: " - , pack $ show (slotTypeForDeclaration x) - ] - Nothing -> - error "malformed variable declaration" - -nodeIs :: Text -> Value -> Bool -nodeIs t x = isSourceNode && hasRightName - where - isSourceNode = - isJust (preview (key "src") x) - hasRightName = - Just t == preview (key "name" . _String) x - -isStorageVariableDeclaration :: Value -> Bool -isStorageVariableDeclaration x = - nodeIs "VariableDeclaration" x - && preview (key "attributes" . key "constant" . _Bool) x /= Just True - -slotTypeForDeclaration :: Value -> SlotType -slotTypeForDeclaration node = - case toList <$> preview (key "children" . _Array) node of - Just (x:_) -> - grokDeclarationType x - _ -> - error "malformed AST" - -grokDeclarationType :: Value -> SlotType -grokDeclarationType x = - case preview (key "name" . _String) x of - Just "Mapping" -> - case preview (key "children" . _Array) x of - Just (toList -> xs) -> - grokMappingType xs - _ -> - error "malformed AST" - Just _ -> - StorageValue (grokValueType x) - _ -> - error ("malformed AST " ++ show x) - -grokMappingType :: [Value] -> SlotType -grokMappingType [s, t] = - case (grokDeclarationType s, grokDeclarationType t) of - (StorageValue s', StorageMapping t' x) -> - StorageMapping (NonEmpty.cons s' t') x - (StorageValue s', StorageValue t') -> - StorageMapping (pure s') t' - (StorageMapping _ _, _) -> - error "unexpected mapping as mapping key" -grokMappingType _ = - error "unexpected AST child count for mapping" - -grokValueType :: Value -> AbiType -grokValueType x = - case ( preview (key "name" . _String) x - , preview (key "children" . _Array) x - , preview (key "attributes" . key "type" . _String) x - ) of - (Just "ElementaryTypeName", _, Just typeName) -> - fromMaybe (error ("ungrokked value type: " ++ show typeName)) - (parseTypeName mempty (head (words typeName))) - (Just "UserDefinedTypeName", _, _) -> - AbiAddressType - (Just "ArrayTypeName", fmap toList -> Just [t], _)-> - AbiArrayDynamicType (grokValueType t) - (Just "ArrayTypeName", fmap toList -> Just [t, n], _)-> - case ( preview (key "name" . _String) n - , preview (key "attributes" . key "value" . _String) n - ) of - (Just "Literal", Just ((read . unpack) -> i)) -> - AbiArrayType i (grokValueType t) - _ -> - error "malformed AST" - _ -> - error ("unknown value type " ++ show x) diff --git a/src/hevm/src/EVM/SymExec.hs b/src/hevm/src/EVM/SymExec.hs deleted file mode 100644 index 5bbf1c03f..000000000 --- a/src/hevm/src/EVM/SymExec.hs +++ /dev/null @@ -1,475 +0,0 @@ -{-# Language DataKinds #-} -{-# Language OverloadedStrings #-} -{-# Language TypeApplications #-} - -module EVM.SymExec where - -import Prelude hiding (Word) - -import Control.Lens hiding (pre) -import EVM hiding (Query, push) -import qualified EVM -import EVM.Exec -import qualified EVM.Fetch as Fetch -import EVM.ABI -import EVM.Stepper (Stepper) -import qualified EVM.Stepper as Stepper -import qualified Control.Monad.Operational as Operational -import Control.Monad.State.Strict hiding (state) -import Data.Maybe (catMaybes, fromMaybe) -import EVM.Types -import EVM.Concrete (createAddress) -import qualified EVM.FeeSchedule as FeeSchedule -import Data.SBV.Trans.Control -import Data.SBV.Trans hiding (distinct, Word) -import Data.SBV hiding (runSMT, newArray_, addAxiom, distinct, sWord8s, Word) -import Data.Vector (toList, fromList) -import Data.Tree -import Data.DoubleWord (Word256) - -import Data.ByteString (ByteString, pack) -import qualified Data.ByteString.Lazy as Lazy -import qualified Data.ByteString as BS -import Data.Text (Text, splitOn, unpack) -import qualified Control.Monad.State.Class as State -import Control.Applicative - -data ProofResult a b c = Qed a | Cex b | Timeout c -type VerifyResult = ProofResult (Tree BranchInfo) (Tree BranchInfo) (Tree BranchInfo) -type EquivalenceResult = ProofResult ([VM], [VM]) VM () - --- | Convenience functions for generating large symbolic byte strings -sbytes32, sbytes128, sbytes256, sbytes512, sbytes1024 :: Query ([SWord 8]) -sbytes32 = toBytes <$> freshVar_ @ (WordN 256) -sbytes128 = toBytes <$> freshVar_ @ (WordN 1024) -sbytes256 = liftA2 (++) sbytes128 sbytes128 -sbytes512 = liftA2 (++) sbytes256 sbytes256 -sbytes1024 = liftA2 (++) sbytes512 sbytes512 - -mkByte :: Query [SWord 8] -mkByte = do x <- freshVar_ - return [x] - --- | Abstract calldata argument generation -symAbiArg :: AbiType -> Query ([SWord 8], W256) -symAbiArg (AbiUIntType n) | n `mod` 8 == 0 && n <= 256 = - do x <- concatMapM (const mkByte) [0..(n `div` 8) - 1] - return (padLeft' 32 x, 32) - | otherwise = error "bad type" - -symAbiArg (AbiIntType n) | n `mod` 8 == 0 && n <= 256 = - do x <- concatMapM (const mkByte) [(0 :: Int) ..(n `div` 8) - 1] - return (padLeft' 32 x, 32) - - | otherwise = error "bad type" -symAbiArg AbiBoolType = - do x <- mkByte - return (padLeft' 32 x, 32) - -symAbiArg AbiAddressType = - do x <- concatMapM (const mkByte) [(0 :: Int)..19] - return (padLeft' 32 x, 32) - -symAbiArg (AbiBytesType n) | n <= 32 = - do x <- concatMapM (const mkByte) [0..n - 1] - return (padLeft' 32 x, 32) - - | otherwise = error "bad type" - --- TODO: is this encoding correct? -symAbiArg (AbiArrayType len typ) = - do args <- mapM symAbiArg (replicate len typ) - return (litBytes (encodeAbiValue (AbiUInt 256 (fromIntegral len))) <> (concat $ fst <$> args), - 32 + (sum $ snd <$> args)) - -symAbiArg (AbiTupleType tuple) = - do args <- mapM symAbiArg (toList tuple) - return (concat $ fst <$> args, sum $ snd <$> args) -symAbiArg n = - error $ "Unsupported symbolic abiencoding for" - <> show n - <> ". Please file an issue at https://github.com/dapphub/dapptools if you really need this." - --- | Generates calldata matching given type signature, optionally specialized --- with concrete arguments. --- Any argument given as "" or omitted at the tail of the list are --- kept symbolic. -symCalldata :: Text -> [AbiType] -> [String] -> Query ([SWord 8], W256) -symCalldata sig typesignature concreteArgs = - let args = concreteArgs <> replicate (length typesignature - length concreteArgs) "" - mkArg typ "" = symAbiArg typ - mkArg typ arg = let n = litBytes . encodeAbiValue $ makeAbiValue typ arg - in return (n, num (length n)) - sig' = litBytes $ selector sig - in do calldatas <- zipWithM mkArg typesignature args - return (sig' <> concat (fst <$> calldatas), 4 + (sum $ snd <$> calldatas)) - -abstractVM :: Maybe (Text, [AbiType]) -> [String] -> ByteString -> StorageModel -> Query VM -abstractVM typesignature concreteArgs x storagemodel = do - (cd', cdlen, cdconstraint) <- - case typesignature of - Nothing -> do cd <- sbytes256 - len <- freshVar_ - return (cd, var "calldataLength" len, (len .<= 256, Todo "calldatalength < 256" [])) - Just (name, typs) -> do (cd, cdlen) <- symCalldata name typs concreteArgs - return (cd, S (Literal cdlen) (literal $ num cdlen), (sTrue, Todo "Trivial" [])) - symstore <- case storagemodel of - SymbolicS -> Symbolic [] <$> freshArray_ Nothing - InitialS -> Symbolic [] <$> freshArray_ (Just 0) - ConcreteS -> return $ Concrete mempty - c <- SAddr <$> freshVar_ - value' <- var "CALLVALUE" <$> freshVar_ - return $ loadSymVM (RuntimeCode (ConcreteBuffer x)) symstore storagemodel c value' (SymbolicBuffer cd', cdlen) & over constraints ((<>) [cdconstraint]) - -loadSymVM :: ContractCode -> Storage -> StorageModel -> SAddr -> SymWord -> (Buffer, SymWord) -> VM -loadSymVM x initStore model addr callvalue' calldata' = - (makeVm $ VMOpts - { vmoptContract = contractWithStore x initStore - , vmoptCalldata = calldata' - , vmoptValue = callvalue' - , vmoptAddress = createAddress ethrunAddress 1 - , vmoptCaller = addr - , vmoptOrigin = ethrunAddress --todo: generalize - , vmoptCoinbase = 0 - , vmoptNumber = 0 - , vmoptTimestamp = 0 - , vmoptBlockGaslimit = 0 - , vmoptGasprice = 0 - , vmoptDifficulty = 0 - , vmoptGas = 0xffffffffffffffff - , vmoptGaslimit = 0xffffffffffffffff - , vmoptBaseFee = 0 - , vmoptPriorityFee = 0 - , vmoptMaxCodeSize = 0xffffffff - , vmoptSchedule = FeeSchedule.berlin - , vmoptChainId = 1 - , vmoptCreate = False - , vmoptStorageModel = model - , vmoptTxAccessList = mempty - , vmoptAllowFFI = False - }) & set (env . contracts . at (createAddress ethrunAddress 1)) - (Just (contractWithStore x initStore)) - -data BranchInfo = BranchInfo - { _vm :: VM, - _branchCondition :: Maybe Whiff - } - -doInterpret :: Fetch.Fetcher -> Maybe Integer -> Maybe Integer -> VM -> Query (Tree BranchInfo) -doInterpret fetcher maxIter askSmtIters vm = let - f (vm', cs) = Node (BranchInfo (if null cs then vm' else vm) Nothing) cs - in f <$> interpret' fetcher maxIter askSmtIters vm - -interpret' :: Fetch.Fetcher -> Maybe Integer -> Maybe Integer -> VM -> Query (VM, [Tree BranchInfo]) -interpret' fetcher maxIter askSmtIters vm = let - cont s = interpret' fetcher maxIter askSmtIters $ execState s vm - in case view EVM.result vm of - - Nothing -> cont exec1 - - Just (VMFailure (EVM.Query q@(PleaseAskSMT _ _ continue))) -> let - codelocation = getCodeLocation vm - iteration = num $ fromMaybe 0 $ view (iterations . at codelocation) vm - -- as an optimization, we skip consulting smt - -- if we've been at the location less than 5 times - in if iteration < (fromMaybe 5 askSmtIters) - then cont $ continue EVM.Unknown - else io (fetcher q) >>= cont - - Just (VMFailure (EVM.Query q)) -> io (fetcher q) >>= cont - - Just (VMFailure (Choose (EVM.PleaseChoosePath whiff continue))) - -> case maxIterationsReached vm maxIter of - Nothing -> let - lvm = execState (continue True) vm - rvm = execState (continue False) vm - in do - push 1 - (leftvm, left) <- interpret' fetcher maxIter askSmtIters lvm - pop 1 - push 1 - (rightvm, right) <- interpret' fetcher maxIter askSmtIters rvm - pop 1 - return (vm, [Node (BranchInfo leftvm (Just whiff)) left, Node (BranchInfo rightvm (Just whiff)) right]) - Just n -> cont $ continue (not n) - - Just _ - -> return (vm, []) - --- | Interpreter which explores all paths at --- | branching points. --- | returns a list of possible final evm states -interpret - :: Fetch.Fetcher - -> Maybe Integer -- max iterations - -> Maybe Integer -- ask smt iterations - -> Stepper a - -> StateT VM Query [a] -interpret fetcher maxIter askSmtIters = - eval . Operational.view - - where - eval - :: Operational.ProgramView Stepper.Action a - -> StateT VM Query [a] - - eval (Operational.Return x) = - pure [x] - - eval (action Operational.:>>= k) = - case action of - Stepper.Exec -> - exec >>= interpret fetcher maxIter askSmtIters . k - Stepper.Run -> - run >>= interpret fetcher maxIter askSmtIters . k - Stepper.IOAct q -> - mapStateT io q >>= interpret fetcher maxIter askSmtIters . k - Stepper.Ask (EVM.PleaseChoosePath _ continue) -> do - vm <- get - case maxIterationsReached vm maxIter of - Nothing -> do - push 1 - a <- interpret fetcher maxIter askSmtIters (Stepper.evm (continue True) >>= k) - put vm - pop 1 - push 1 - b <- interpret fetcher maxIter askSmtIters (Stepper.evm (continue False) >>= k) - pop 1 - return $ a <> b - Just n -> - interpret fetcher maxIter askSmtIters (Stepper.evm (continue (not n)) >>= k) - Stepper.Wait q -> do - let performQuery = do - m <- liftIO (fetcher q) - interpret fetcher maxIter askSmtIters (Stepper.evm m >>= k) - - case q of - PleaseAskSMT _ _ continue -> do - codelocation <- getCodeLocation <$> get - iteration <- num . fromMaybe 0 <$> use (iterations . at codelocation) - - -- if this is the first time we are branching at this point, - -- explore both branches without consulting SMT. - -- Exploring too many branches is a lot cheaper than - -- consulting our SMT solver. - if iteration < (fromMaybe 5 askSmtIters) - then interpret fetcher maxIter askSmtIters (Stepper.evm (continue EVM.Unknown) >>= k) - else performQuery - - _ -> performQuery - - Stepper.EVM m -> - State.state (runState m) >>= interpret fetcher maxIter askSmtIters . k - -maxIterationsReached :: VM -> Maybe Integer -> Maybe Bool -maxIterationsReached _ Nothing = Nothing -maxIterationsReached vm (Just maxIter) = - let codelocation = getCodeLocation vm - iters = view (iterations . at codelocation . non 0) vm - in if num maxIter <= iters - then view (cache . path . at (codelocation, iters - 1)) vm - else Nothing - -type Precondition = VM -> SBool -type Postcondition = (VM, VM) -> SBool - -checkAssert :: [Word256] -> ByteString -> Maybe (Text, [AbiType]) -> [String] -> Query (VerifyResult, VM) -checkAssert errs c signature' concreteArgs = verifyContract c signature' concreteArgs SymbolicS (const sTrue) (Just $ checkAssertions errs) - -{- |Checks if an assertion violation has been encountered - - hevm recognises the following as an assertion violation: - - 1. the invalid opcode (0xfe) (solc < 0.8) - 2. a revert with a reason of the form `abi.encodeWithSelector("Panic(uint256)", code)`, where code is one of the following (solc >= 0.8): - - 0x00: Used for generic compiler inserted panics. - - 0x01: If you call assert with an argument that evaluates to false. - - 0x11: If an arithmetic operation results in underflow or overflow outside of an unchecked { ... } block. - - 0x12; If you divide or modulo by zero (e.g. 5 / 0 or 23 % 0). - - 0x21: If you convert a value that is too big or negative into an enum type. - - 0x22: If you access a storage byte array that is incorrectly encoded. - - 0x31: If you call .pop() on an empty array. - - 0x32: If you access an array, bytesN or an array slice at an out-of-bounds or negative index (i.e. x[i] where i >= x.length or i < 0). - - 0x41: If you allocate too much memory or create an array that is too large. - - 0x51: If you call a zero-initialized variable of internal function type. - - see: https://docs.soliditylang.org/en/v0.8.6/control-structures.html?highlight=Panic#panic-via-assert-and-error-via-require --} -checkAssertions :: [Word256] -> Postcondition -checkAssertions errs (_, out) = case view result out of - Just (EVM.VMFailure (EVM.UnrecognizedOpcode 254)) -> sFalse - Just (EVM.VMFailure (EVM.Revert msg)) -> if msg `elem` (fmap panicMsg errs) then sFalse else sTrue - _ -> sTrue - --- |By default hevm checks for all assertions except those which result from arithmetic overflow -defaultPanicCodes :: [Word256] -defaultPanicCodes = [ 0x00, 0x01, 0x12, 0x21, 0x22, 0x31, 0x32, 0x41, 0x51 ] - -allPanicCodes :: [Word256] -allPanicCodes = [ 0x00, 0x01, 0x11, 0x12, 0x21, 0x22, 0x31, 0x32, 0x41, 0x51 ] - --- |Produces the revert message for solc >=0.8 assertion violations -panicMsg :: Word256 -> ByteString -panicMsg err = (selector "Panic(uint256)") <> (encodeAbiValue $ AbiUInt 256 err) - -verifyContract :: ByteString -> Maybe (Text, [AbiType]) -> [String] -> StorageModel -> Precondition -> Maybe Postcondition -> Query (VerifyResult, VM) -verifyContract theCode signature' concreteArgs storagemodel pre maybepost = do - preStateRaw <- abstractVM signature' concreteArgs theCode storagemodel - -- add the pre condition to the pathconditions to ensure that we are only exploring valid paths - let preState = over constraints ((++) [(pre preStateRaw, Todo "assumptions" [])]) preStateRaw - v <- verify preState Nothing Nothing Nothing maybepost - return (v, preState) - -pruneDeadPaths :: [VM] -> [VM] -pruneDeadPaths = - filter $ \vm -> case view result vm of - Just (VMFailure DeadPath) -> False - _ -> True - -consistentPath :: VM -> Query (Maybe VM) -consistentPath vm = do - resetAssertions - constrain $ sAnd $ fst <$> view constraints vm - checkSat >>= \case - Sat -> return $ Just vm - Unk -> return $ Just vm -- the path may still be consistent - Unsat -> return Nothing - DSat _ -> error "unexpected DSAT" - -consistentTree :: Tree BranchInfo -> Query (Maybe (Tree BranchInfo)) -consistentTree (Node (BranchInfo vm w) []) = do - consistentPath vm >>= \case - Nothing -> return Nothing - Just vm' -> return $ Just $ Node (BranchInfo vm' w) [] -consistentTree (Node b xs) = do - consistentChildren <- catMaybes <$> forM xs consistentTree - if null consistentChildren then - return Nothing - else - return $ Just (Node b consistentChildren) - - -leaves :: Tree BranchInfo -> [VM] -leaves (Node x []) = [_vm x] -leaves (Node _ xs) = concatMap leaves xs - --- | Symbolically execute the VM and check all endstates against the postcondition, if available. -verify :: VM -> Maybe Integer -> Maybe Integer -> Maybe (Fetch.BlockNumber, Text) -> Maybe Postcondition -> Query VerifyResult -verify preState maxIter askSmtIters rpcinfo maybepost = do - smtState <- queryState - tree <- doInterpret (Fetch.oracle (Just smtState) rpcinfo False) maxIter askSmtIters preState - case maybepost of - (Just post) -> do - let livePaths = pruneDeadPaths $ leaves tree - -- have we hit max iterations at any point in a given path - maxReached :: VM -> Bool - maxReached p = case maxIter of - Just maxI -> any (>= (fromInteger maxI)) (view iterations p) - Nothing -> False - -- is there any path which can possibly violate the postcondition? - -- can also do these queries individually (even concurrently!). Could save time and report multiple violations - postC = sOr $ fmap (\postState -> (sAnd (fst <$> view constraints postState)) .&& sNot (post (preState, postState))) livePaths - resetAssertions - constrain postC - io $ putStrLn "checking postcondition..." - checkSat >>= \case - Unk -> do io $ putStrLn "postcondition query timed out" - return $ Timeout tree - Unsat -> do - if any maxReached livePaths - then io $ putStrLn "WARNING: max iterations reached, execution halted prematurely" - else io $ putStrLn "Q.E.D." - return $ Qed tree - Sat -> return $ Cex tree - DSat _ -> error "unexpected DSAT" - - Nothing -> do io $ putStrLn "Nothing to check" - return $ Qed tree - --- | Compares two contract runtimes for trace equivalence by running two VMs and comparing the end states. -equivalenceCheck :: ByteString -> ByteString -> Maybe Integer -> Maybe Integer -> Maybe (Text, [AbiType]) -> Query EquivalenceResult -equivalenceCheck bytecodeA bytecodeB maxiter askSmtIters signature' = do - let - bytecodeA' = if BS.null bytecodeA then BS.pack [0] else bytecodeA - bytecodeB' = if BS.null bytecodeB then BS.pack [0] else bytecodeB - preStateA <- abstractVM signature' [] bytecodeA' SymbolicS - - let preself = preStateA ^. state . contract - precaller = preStateA ^. state . caller - callvalue' = preStateA ^. state . callvalue - prestorage = preStateA ^?! env . contracts . ix preself . storage - (calldata', cdlen) = view (state . calldata) preStateA - pathconds = view constraints preStateA - preStateB = loadSymVM (RuntimeCode (ConcreteBuffer bytecodeB')) prestorage SymbolicS precaller callvalue' (calldata', cdlen) & set constraints pathconds - - smtState <- queryState - push 1 - aVMs <- doInterpret (Fetch.oracle (Just smtState) Nothing False) maxiter askSmtIters preStateA - pop 1 - push 1 - bVMs <- doInterpret (Fetch.oracle (Just smtState) Nothing False) maxiter askSmtIters preStateB - pop 1 - -- Check each pair of endstates for equality: - let differingEndStates = uncurry distinct <$> [(a,b) | a <- pruneDeadPaths (leaves aVMs), b <- pruneDeadPaths (leaves bVMs)] - distinct a b = - let (aPath, bPath) = both' (view constraints) (a, b) - (aSelf, bSelf) = both' (view (state . contract)) (a, b) - (aEnv, bEnv) = both' (view (env . contracts)) (a, b) - (aResult, bResult) = both' (view result) (a, b) - (Symbolic _ aStorage, Symbolic _ bStorage) = (view storage (aEnv ^?! ix aSelf), view storage (bEnv ^?! ix bSelf)) - differingResults = case (aResult, bResult) of - - (Just (VMSuccess aOut), Just (VMSuccess bOut)) -> - aOut ./= bOut .|| aStorage ./= bStorage .|| fromBool (aSelf /= bSelf) - - (Just (VMFailure UnexpectedSymbolicArg), _) -> - error $ "Unexpected symbolic argument at opcode: " <> maybe "??" show (vmOp a) <> ". Not supported (yet!)" - - (_, Just (VMFailure UnexpectedSymbolicArg)) -> - error $ "Unexpected symbolic argument at opcode: " <> maybe "??" show (vmOp a) <> ". Not supported (yet!)" - - (Just (VMFailure _), Just (VMFailure _)) -> sFalse - - (Just _, Just _) -> sTrue - - errormsg -> error $ show errormsg - - in sAnd (fst <$> aPath) .&& sAnd (fst <$> bPath) .&& differingResults - -- If there exists a pair of endstates where this is not the case, - -- the following constraint is satisfiable - constrain $ sOr differingEndStates - - checkSat >>= \case - Unk -> return $ Timeout () - Sat -> return $ Cex preStateA - Unsat -> return $ Qed (leaves aVMs, leaves bVMs) - DSat _ -> error "unexpected DSAT" - -both' :: (a -> b) -> (a, a) -> (b, b) -both' f (x, y) = (f x, f y) - -showCounterexample :: VM -> Maybe (Text, [AbiType]) -> Query () -showCounterexample vm maybesig = do - let (calldata', S _ cdlen) = view (EVM.state . EVM.calldata) vm - S _ cvalue = view (EVM.state . EVM.callvalue) vm - SAddr caller' = view (EVM.state . EVM.caller) vm - cdlen' <- num <$> getValue cdlen - calldatainput <- case calldata' of - SymbolicBuffer cd -> mapM (getValue.fromSized) (take cdlen' cd) >>= return . pack - ConcreteBuffer cd -> return $ BS.take cdlen' cd - callvalue' <- getValue cvalue - caller'' <- num <$> getValue caller' - io $ do - putStrLn "Calldata:" - print $ ByteStringS calldatainput - - -- pretty print calldata input if signature is available - case maybesig of - Just (name, types) -> putStrLn $ unpack (head (splitOn "(" name)) ++ - show (decodeAbiValue (AbiTupleType (fromList types)) $ Lazy.fromStrict (BS.drop 4 calldatainput)) - Nothing -> return () - - putStrLn "Caller:" - print (Addr caller'') - putStrLn "Callvalue:" - print callvalue' diff --git a/src/hevm/src/EVM/Symbolic.hs b/src/hevm/src/EVM/Symbolic.hs deleted file mode 100644 index 12142c028..000000000 --- a/src/hevm/src/EVM/Symbolic.hs +++ /dev/null @@ -1,321 +0,0 @@ -{-# Language NamedFieldPuns #-} -{-# Language DataKinds #-} -{-# Language OverloadedStrings #-} -{-# Language TypeApplications #-} -{-# Language ScopedTypeVariables #-} - -module EVM.Symbolic where - -import Prelude hiding (Word, LT, GT) -import qualified Data.ByteString as BS -import Data.ByteString (ByteString) -import Control.Lens hiding (op, (:<), (|>), (.>)) -import Data.Maybe (fromMaybe, fromJust) - -import EVM.Types -import qualified EVM.Concrete as Concrete -import qualified Data.ByteArray as BA -import Data.SBV hiding (runSMT, newArray_, addAxiom, Word) -import Data.SBV.Tools.Overflow -import Crypto.Hash (Digest, SHA256) -import qualified Crypto.Hash as Crypto - -litWord :: Word -> SymWord -litWord (C whiff a) = S whiff (literal $ toSizzle a) - -litAddr :: Addr -> SAddr -litAddr = SAddr . literal . toSizzle - -maybeLitAddr :: SAddr -> Maybe Addr -maybeLitAddr (SAddr a) = fmap fromSizzle (unliteral a) - -maybeLitBytes :: [SWord 8] -> Maybe ByteString -maybeLitBytes xs = fmap (\x -> BS.pack (fmap fromSized x)) (mapM unliteral xs) - --- | Note: the (force*) functions are crude and in general, --- the continuation passing style `forceConcrete` --- alternatives should be prefered for better error --- handling when used during EVM execution -forceLit :: SymWord -> Word -forceLit (S whiff a) = case unliteral a of - Just c -> C whiff (fromSizzle c) - Nothing -> error "unexpected symbolic argument" - -forceLitBytes :: [SWord 8] -> ByteString -forceLitBytes = BS.pack . fmap (fromSized . fromJust . unliteral) - -forceBuffer :: Buffer -> ByteString -forceBuffer (ConcreteBuffer b) = b -forceBuffer (SymbolicBuffer b) = forceLitBytes b - -sdiv :: SymWord -> SymWord -> SymWord -sdiv (S a x) (S b y) = let sx, sy :: SInt 256 - sx = sFromIntegral x - sy = sFromIntegral y - in S (Div a b) (sFromIntegral (sx `sQuot` sy)) - -smod :: SymWord -> SymWord -> SymWord -smod (S a x) (S b y) = let sx, sy :: SInt 256 - sx = sFromIntegral x - sy = sFromIntegral y - in S (Mod a b) $ ite (y .== 0) 0 (sFromIntegral (sx `sRem` sy)) - -addmod :: SymWord -> SymWord -> SymWord -> SymWord -addmod (S a x) (S b y) (S c z) = let to512 :: SWord 256 -> SWord 512 - to512 = sFromIntegral - in S (Todo "addmod" [a, b, c]) $ ite (z .== 0) 0 $ sFromIntegral $ ((to512 x) + (to512 y)) `sMod` (to512 z) - -mulmod :: SymWord -> SymWord -> SymWord -> SymWord -mulmod (S a x) (S b y) (S c z) = let to512 :: SWord 256 -> SWord 512 - to512 = sFromIntegral - in S (Todo "mulmod" [a, b, c]) $ ite (z .== 0) 0 $ sFromIntegral $ ((to512 x) * (to512 y)) `sMod` (to512 z) - --- | Signed less than -slt :: SymWord -> SymWord -> SymWord -slt (S xw x) (S yw y) = - iteWhiff (SLT xw yw) (sFromIntegral x .< (sFromIntegral y :: (SInt 256))) 1 0 - --- | Signed greater than -sgt :: SymWord -> SymWord -> SymWord -sgt (S xw x) (S yw y) = - iteWhiff (SGT xw yw) (sFromIntegral x .> (sFromIntegral y :: (SInt 256))) 1 0 - --- * Operations over symbolic memory (list of symbolic bytes) -swordAt :: Int -> [SWord 8] -> SymWord -swordAt i bs = let bs' = truncpad 32 $ drop i bs - in S (FromBytes (SymbolicBuffer bs')) (fromBytes bs') - -readByteOrZero' :: Int -> [SWord 8] -> SWord 8 -readByteOrZero' i bs = fromMaybe 0 (bs ^? ix i) - -sliceWithZero' :: Int -> Int -> [SWord 8] -> [SWord 8] -sliceWithZero' o s m = truncpad s $ drop o m - -writeMemory' :: [SWord 8] -> Word -> Word -> Word -> [SWord 8] -> [SWord 8] -writeMemory' bs1 (C _ n) (C _ src) (C _ dst) bs0 = - let - (a, b) = splitAt (num dst) bs0 - a' = replicate (num dst - length a) 0 - c = if src > num (length bs1) - then replicate (num n) 0 - else sliceWithZero' (num src) (num n) bs1 - b' = drop (num (n)) b - in - a <> a' <> c <> b' - -readMemoryWord' :: Word -> [SWord 8] -> SymWord -readMemoryWord' (C _ i) m = - let bs = truncpad 32 (drop (num i) m) - in S (FromBytes (SymbolicBuffer bs)) (fromBytes bs) - -readMemoryWord32' :: Word -> [SWord 8] -> SWord 32 -readMemoryWord32' (C _ i) m = fromBytes $ truncpad 4 (drop (num i) m) - -setMemoryWord' :: Word -> SymWord -> [SWord 8] -> [SWord 8] -setMemoryWord' (C _ i) (S _ x) = - writeMemory' (toBytes x) 32 0 (num i) - -setMemoryByte' :: Word -> SWord 8 -> [SWord 8] -> [SWord 8] -setMemoryByte' (C _ i) x = - writeMemory' [x] 1 0 (num i) - -readSWord' :: Word -> [SWord 8] -> SymWord -readSWord' (C _ i) x = - if i > num (length x) - then 0 - else swordAt (num i) x - - -select' :: (Ord b, Num b, SymVal b, Mergeable a) => [a] -> a -> SBV b -> a -select' xs err ind = walk xs ind err - where walk [] _ acc = acc - walk (e:es) i acc = walk es (i-1) (ite (i .== 0) e acc) - --- | Read 32 bytes from index from a bounded list of bytes. -readSWordWithBound :: SymWord -> Buffer -> SymWord -> SymWord -readSWordWithBound sind@(S _ ind) (SymbolicBuffer xs) (S _ bound) = case (num <$> maybeLitWord sind, num <$> fromSizzle <$> unliteral bound) of - (Just i, Just b) -> - let bs = truncpad 32 $ drop i (take b xs) - in S (FromBytes (SymbolicBuffer bs)) (fromBytes bs) - _ -> - -- Generates a ridiculously large set of constraints (roughly 25k) when - -- the index is symbolic, but it still seems (kind of) manageable - -- for the solvers. - - -- The proper solution here is to use smt arrays instead. - - let boundedList = [ite (i .<= bound) x' 0 | (x', i) <- zip xs [1..]] - res = [select' boundedList 0 (ind + j) | j <- [0..31]] - in S (FromBytes $ SymbolicBuffer res) $ fromBytes res - -readSWordWithBound sind (ConcreteBuffer xs) bound = - case maybeLitWord sind of - Nothing -> readSWordWithBound sind (SymbolicBuffer (litBytes xs)) bound - Just x' -> - -- INVARIANT: bound should always be length xs for concrete bytes - -- so we should be able to safely ignore it here - litWord $ Concrete.readMemoryWord x' xs - --- a whole foldable instance seems overkill, but length is always good to have! -len :: Buffer -> Int -len (SymbolicBuffer bs) = length bs -len (ConcreteBuffer bs) = BS.length bs - -readByteOrZero :: Int -> Buffer -> SWord 8 -readByteOrZero i (SymbolicBuffer bs) = readByteOrZero' i bs -readByteOrZero i (ConcreteBuffer bs) = num $ Concrete.readByteOrZero i bs - -sliceWithZero :: Int -> Int -> Buffer -> Buffer -sliceWithZero o s (SymbolicBuffer m) = SymbolicBuffer (sliceWithZero' o s m) -sliceWithZero o s (ConcreteBuffer m) = ConcreteBuffer (Concrete.byteStringSliceWithDefaultZeroes o s m) - -writeMemory :: Buffer -> Word -> Word -> Word -> Buffer -> Buffer -writeMemory (ConcreteBuffer bs1) n src dst (ConcreteBuffer bs0) = - ConcreteBuffer (Concrete.writeMemory bs1 n src dst bs0) -writeMemory (ConcreteBuffer bs1) n src dst (SymbolicBuffer bs0) = - SymbolicBuffer (writeMemory' (litBytes bs1) n src dst bs0) -writeMemory (SymbolicBuffer bs1) n src dst (ConcreteBuffer bs0) = - SymbolicBuffer (writeMemory' bs1 n src dst (litBytes bs0)) -writeMemory (SymbolicBuffer bs1) n src dst (SymbolicBuffer bs0) = - SymbolicBuffer (writeMemory' bs1 n src dst bs0) - -readMemoryWord :: Word -> Buffer -> SymWord -readMemoryWord i (SymbolicBuffer m) = readMemoryWord' i m -readMemoryWord i (ConcreteBuffer m) = litWord $ Concrete.readMemoryWord i m - -readMemoryWord32 :: Word -> Buffer -> SWord 32 -readMemoryWord32 i (SymbolicBuffer m) = readMemoryWord32' i m -readMemoryWord32 i (ConcreteBuffer m) = num $ Concrete.readMemoryWord32 i m - -setMemoryWord :: Word -> SymWord -> Buffer -> Buffer -setMemoryWord i x (SymbolicBuffer z) = SymbolicBuffer $ setMemoryWord' i x z -setMemoryWord i x (ConcreteBuffer z) = case maybeLitWord x of - Just x' -> ConcreteBuffer $ Concrete.setMemoryWord i x' z - Nothing -> SymbolicBuffer $ setMemoryWord' i x (litBytes z) - -setMemoryByte :: Word -> SWord 8 -> Buffer -> Buffer -setMemoryByte i x (SymbolicBuffer m) = SymbolicBuffer $ setMemoryByte' i x m -setMemoryByte i x (ConcreteBuffer m) = case fromSized <$> unliteral x of - Nothing -> SymbolicBuffer $ setMemoryByte' i x (litBytes m) - Just x' -> ConcreteBuffer $ Concrete.setMemoryByte i x' m - -readSWord :: Word -> Buffer -> SymWord -readSWord i (SymbolicBuffer x) = readSWord' i x -readSWord i (ConcreteBuffer x) = num $ Concrete.readMemoryWord i x - -index :: Int -> Buffer -> SWord8 -index x (ConcreteBuffer b) = literal $ BS.index b x -index x (SymbolicBuffer b) = fromSized $ b !! x - --- * Uninterpreted functions - -symSHA256N :: SInteger -> SInteger -> SWord 256 -symSHA256N = uninterpret "sha256" - -symkeccakN :: SInteger -> SInteger -> SWord 256 -symkeccakN = uninterpret "keccak" - -toSInt :: [SWord 8] -> SInteger -toSInt bs = sum $ zipWith (\a (i :: Integer) -> sFromIntegral a * 256 ^ i) bs [0..] - - --- | Although we'd like to define this directly as an uninterpreted function, --- we cannot because [a] is not a symbolic type. We must convert the list into a suitable --- symbolic type first. The only important property of this conversion is that it is injective. --- We embedd the bytestring as a pair of symbolic integers, this is a fairly easy solution. -symkeccak' :: [SWord 8] -> SWord 256 -symkeccak' bytes = case length bytes of - 0 -> literal $ toSizzle $ keccak "" - n -> symkeccakN (num n) (toSInt bytes) - -symSHA256 :: [SWord 8] -> [SWord 8] -symSHA256 bytes = case length bytes of - 0 -> litBytes $ BS.pack $ BA.unpack $ (Crypto.hash BS.empty :: Digest SHA256) - n -> toBytes $ symSHA256N (num n) (toSInt bytes) - -rawVal :: SymWord -> SWord 256 -rawVal (S _ v) = v - --- | Reconstruct the smt/sbv value from a whiff --- Should satisfy (rawVal x .== whiffValue x) -whiffValue :: Whiff -> SWord 256 -whiffValue w = case w of - w'@(Todo _ _) -> error $ "unable to get value of " ++ show w' - And x y -> whiffValue x .&. whiffValue y - Or x y -> whiffValue x .|. whiffValue y - Eq x y -> ite (whiffValue x .== whiffValue y) 1 0 - LT x y -> ite (whiffValue x .< whiffValue y) 1 0 - GT x y -> ite (whiffValue x .> whiffValue y) 1 0 - ITE b x y -> ite (whiffValue b .== 1) (whiffValue x) (whiffValue y) - SLT x y -> rawVal $ slt (S x (whiffValue x)) (S y (whiffValue y)) - SGT x y -> rawVal $ sgt (S x (whiffValue x)) (S y (whiffValue y)) - IsZero x -> ite (whiffValue x .== 0) 1 0 - SHL x y -> sShiftLeft (whiffValue x) (whiffValue y) - SHR x y -> sShiftRight (whiffValue x) (whiffValue y) - SAR x y -> sSignedShiftArithRight (whiffValue x) (whiffValue y) - Add x y -> whiffValue x + whiffValue y - Sub x y -> whiffValue x - whiffValue y - Mul x y -> whiffValue x * whiffValue y - Div x y -> whiffValue x `sDiv` whiffValue y - Mod x y -> whiffValue x `sMod` whiffValue y - Exp x y -> whiffValue x .^ whiffValue y - Neg x -> complement $ whiffValue x - Var _ v -> v - FromKeccak (ConcreteBuffer bstr) -> literal $ num $ keccak bstr - FromKeccak (SymbolicBuffer buf) -> symkeccak' buf - Literal x -> literal $ num $ x - FromBytes buf -> rawVal $ readMemoryWord 0 buf - FromStorage ind arr -> readArray arr (whiffValue ind) - --- | Special cases that have proven useful in practice -simplifyCondition :: SBool -> Whiff -> SBool -simplifyCondition _ (IsZero (IsZero (IsZero a))) = whiffValue a .== 0 - - - --- | Overflow safe math can be difficult for smt solvers to deal with, --- especially for 256-bit words. When we recognize terms arising from --- overflow checks, we translate our queries into a more bespoke form, --- outlined in: --- Modular Bug-finding for Integer Overflows in the Large: --- Sound, Efficient, Bit-precise Static Analysis --- www.microsoft.com/en-us/research/wp-content/uploads/2016/02/z3prefix.pdf --- --- Addition overflow. --- Written as --- require (x <= (x + y)) --- or require (y <= (x + y)) --- or require (!(y < (x + y))) -simplifyCondition b (IsZero (IsZero (LT (Add x y) z))) = - let x' = whiffValue x - y' = whiffValue y - z' = whiffValue z - (_, overflow) = bvAddO x' y' - in - ite (x' .== z' .|| - y' .== z') - overflow - b - --- Multiplication overflow. --- Written as --- require (y == 0 || x * y / y == x) --- or require (y == 0 || x == x * y / y) - --- proveWith cvc4 $ \x y z -> ite (y .== (z :: SWord 8)) (((x * y) `sDiv` z ./= x) .<=> (snd (bvMulO x y) .|| (z .== 0 .&& x .> 0))) (sTrue) --- Q.E.D. -simplifyCondition b (IsZero (Eq x (Div (Mul y z) w))) = - simplifyCondition b (IsZero (Eq (Div (Mul y z) w) x)) -simplifyCondition b (IsZero (Eq (Div (Mul y z) w) x)) = - let x' = whiffValue x - y' = whiffValue y - z' = whiffValue z - w' = whiffValue w - (_, overflow) = bvMulO y' z' - in - ite - ((y' .== x' .&& z' .== w') .|| - (z' .== x' .&& y' .== w')) - (overflow .|| (w' .== 0 .&& x' ./= 0)) - b -simplifyCondition b _ = b diff --git a/src/hevm/src/EVM/TTY.hs b/src/hevm/src/EVM/TTY.hs deleted file mode 100644 index a2397775f..000000000 --- a/src/hevm/src/EVM/TTY.hs +++ /dev/null @@ -1,1049 +0,0 @@ -{-# Language TemplateHaskell #-} -{-# Language ImplicitParams #-} -{-# Language DataKinds #-} -module EVM.TTY where - -import Prelude hiding (lookup, Word) - -import Brick -import Brick.Widgets.Border -import Brick.Widgets.Center -import Brick.Widgets.List - -import EVM -import EVM.ABI (abiTypeSolidity, decodeAbiValue, AbiType(..), emptyAbi) -import EVM.SymExec (maxIterationsReached, symCalldata) -import EVM.Dapp (DappInfo, dappInfo, Test, extractSig, Test(..), srcMap) -import EVM.Dapp (dappUnitTests, unitTestMethods, dappSolcByName, dappSolcByHash, dappSources) -import EVM.Dapp (dappAstSrcMap) -import EVM.Debug -import EVM.Format (showWordExact, showWordExplanation) -import EVM.Format (contractNamePart, contractPathPart, showTraceTree) -import EVM.Hexdump (prettyHex) -import EVM.Op -import EVM.Solidity hiding (storageLayout) -import EVM.Types hiding (padRight) -import EVM.UnitTest -import EVM.StorageLayout - -import EVM.Stepper (Stepper) -import qualified EVM.Stepper as Stepper -import qualified Control.Monad.Operational as Operational - -import EVM.Fetch (Fetcher) - -import Control.Lens hiding (List) -import Control.Monad.Trans.Reader -import Control.Monad.State.Strict hiding (state) - -import Data.Aeson.Lens -import Data.ByteString (ByteString) -import Data.Maybe (isJust, fromJust, fromMaybe) -import Data.Map (Map, insert, lookupLT, singleton, filter) -import Data.Text (Text, pack) -import Data.Text.Encoding (decodeUtf8) -import Data.List (sort, find) -import Data.Version (showVersion) -import Data.SBV hiding (solver) - -import qualified Data.SBV.Internals as SBV -import qualified Data.ByteString as BS -import qualified Data.Map as Map -import qualified Data.Text as Text -import qualified Data.Vector as Vec -import qualified Data.Vector.Storable as SVec -import qualified Graphics.Vty as V -import qualified System.Console.Haskeline as Readline - -import qualified EVM.TTYCenteredList as Centered - -import qualified Paths_hevm as Paths - -data Name - = AbiPane - | StackPane - | BytecodePane - | TracePane - | SolidityPane - | TestPickerPane - | BrowserPane - | Pager - deriving (Eq, Show, Ord) - -type UiWidget = Widget Name - -data UiVmState = UiVmState - { _uiVm :: VM - , _uiStep :: Int - , _uiSnapshots :: Map Int (VM, Stepper ()) - , _uiStepper :: Stepper () - , _uiShowMemory :: Bool - , _uiTestOpts :: UnitTestOptions - } - -data UiTestPickerState = UiTestPickerState - { _testPickerList :: List Name (Text, Text) - , _testPickerDapp :: DappInfo - , _testOpts :: UnitTestOptions - } - -data UiBrowserState = UiBrowserState - { _browserContractList :: List Name (Addr, Contract) - , _browserVm :: UiVmState - } - -data UiState - = ViewVm UiVmState - | ViewContracts UiBrowserState - | ViewPicker UiTestPickerState - | ViewHelp UiVmState - -makeLenses ''UiVmState -makeLenses ''UiTestPickerState -makeLenses ''UiBrowserState -makePrisms ''UiState - --- caching VM states lets us backstep efficiently -snapshotInterval :: Int -snapshotInterval = 50 - -type Pred a = a -> Bool - -data StepMode - = Step !Int -- ^ Run a specific number of steps - | StepUntil (Pred VM) -- ^ Finish when a VM predicate holds - --- | Each step command in the terminal should finish immediately --- with one of these outcomes. -data Continuation a - = Stopped a -- ^ Program finished - | Continue (Stepper a) -- ^ Took one step; more steps to go - - --- | This turns a @Stepper@ into a state action usable --- from within the TTY loop, yielding a @StepOutcome@ depending on the @StepMode@. -interpret - :: (?fetcher :: Fetcher - , ?maxIter :: Maybe Integer) - => StepMode - -> Stepper a - -> StateT UiVmState IO (Continuation a) -interpret mode = - - -- Like the similar interpreters in @EVM.UnitTest@ and @EVM.VMTest@, - -- this one is implemented as an "operational monad interpreter". - - eval . Operational.view - where - eval - :: Operational.ProgramView Stepper.Action a - -> StateT UiVmState IO (Continuation a) - - eval (Operational.Return x) = - pure (Stopped x) - - eval (action Operational.:>>= k) = - case action of - - Stepper.Run -> do - -- Have we reached the final result of this action? - use (uiVm . result) >>= \case - Just _ -> do - -- Yes, proceed with the next action. - vm <- use uiVm - interpret mode (k vm) - Nothing -> do - -- No, keep performing the current action - keepExecuting mode (Stepper.run >>= k) - - -- Stepper wants to keep executing? - Stepper.Exec -> do - -- Have we reached the final result of this action? - use (uiVm . result) >>= \case - Just r -> - -- Yes, proceed with the next action. - interpret mode (k r) - Nothing -> do - -- No, keep performing the current action - keepExecuting mode (Stepper.exec >>= k) - - -- Stepper is waiting for user input from a query - Stepper.Ask (PleaseChoosePath _ cont) -> do - -- ensure we aren't stepping past max iterations - vm <- use uiVm - case maxIterationsReached vm ?maxIter of - Nothing -> pure $ Continue (k ()) - Just n -> interpret mode (Stepper.evm (cont (not n)) >>= k) - - -- Stepper wants to make a query and wait for the results? - Stepper.Wait q -> do - do m <- liftIO (?fetcher q) - interpret mode (Stepper.evm m >>= k) - - -- Stepper wants to make a query and wait for the results? - Stepper.IOAct q -> do - zoom uiVm (StateT (runStateT q)) >>= interpret mode . k - - -- Stepper wants to modify the VM. - Stepper.EVM m -> do - vm <- use uiVm - let (r, vm1) = runState m vm - assign uiVm vm1 - interpret mode (Stepper.exec >> (k r)) - -keepExecuting :: (?fetcher :: Fetcher - , ?maxIter :: Maybe Integer) - => StepMode - -> Stepper a - -> StateT UiVmState IO (Continuation a) -keepExecuting mode restart = case mode of - Step 0 -> do - -- We come here when we've continued while stepping, - -- either from a query or from a return; - -- we should pause here and wait for the user. - pure (Continue restart) - - Step i -> do - -- Run one instruction and recurse - stepOneOpcode restart - interpret (Step (i - 1)) restart - - StepUntil p -> do - vm <- use uiVm - if p vm - then - interpret (Step 0) restart - else do - -- Run one instruction and recurse - stepOneOpcode restart - interpret (StepUntil p) restart - -isUnitTestContract :: Text -> DappInfo -> Bool -isUnitTestContract name dapp = - elem name (map fst (view dappUnitTests dapp)) - -mkVty :: IO V.Vty -mkVty = do - vty <- V.mkVty V.defaultConfig - V.setMode (V.outputIface vty) V.BracketedPaste True - return vty - -runFromVM :: Maybe Integer -> DappInfo -> (Query -> IO (EVM ())) -> VM -> IO VM -runFromVM maxIter' dappinfo oracle' vm = do - - let - opts = UnitTestOptions - { oracle = oracle' - , verbose = Nothing - , maxIter = maxIter' - , askSmtIters = Nothing - , smtTimeout = Nothing - , smtState = Nothing - , solver = Nothing - , maxDepth = Nothing - , match = "" - , fuzzRuns = 1 - , replay = error "irrelevant" - , vmModifier = id - , testParams = error "irrelevant" - , dapp = dappinfo - , ffiAllowed = False - , covMatch = Nothing - } - ui0 = initUiVmState vm opts (void Stepper.execFully) - - v <- mkVty - ui2 <- customMain v mkVty Nothing (app opts) (ViewVm ui0) - case ui2 of - ViewVm ui -> return (view uiVm ui) - _ -> error "internal error: customMain returned prematurely" - - -initUiVmState :: VM -> UnitTestOptions -> Stepper () -> UiVmState -initUiVmState vm0 opts script = - UiVmState - { _uiVm = vm0 - , _uiStepper = script - , _uiStep = 0 - , _uiSnapshots = singleton 0 (vm0, script) - , _uiShowMemory = False - , _uiTestOpts = opts - } - - --- filters out fuzztests, unless they have --- explicitly been given an argument by `replay` -debuggableTests :: UnitTestOptions -> (Text, [(Test, [AbiType])]) -> [(Text, Text)] -debuggableTests UnitTestOptions{..} (contractname, tests) = case replay of - Nothing -> [(contractname, extractSig $ fst x) | x <- tests, not $ isFuzzTest x] - Just (sig, _) -> [(contractname, extractSig $ fst x) | x <- tests, not (isFuzzTest x) || extractSig (fst x) == sig] - -isFuzzTest :: (Test, [AbiType]) -> Bool -isFuzzTest (SymbolicTest _, _) = False -isFuzzTest (ConcreteTest _, []) = False -isFuzzTest (ConcreteTest _, _) = True -isFuzzTest (InvariantTest _, _) = True - -main :: UnitTestOptions -> FilePath -> FilePath -> IO () -main opts root jsonFilePath = - readSolc jsonFilePath >>= - \case - Nothing -> - error "Failed to read Solidity JSON" - Just (contractMap, sourceCache) -> do - let - dapp = dappInfo root contractMap sourceCache - ui = ViewPicker $ UiTestPickerState - { _testPickerList = - list - TestPickerPane - (Vec.fromList - (concatMap - (debuggableTests opts) - (view dappUnitTests dapp))) - 1 - , _testPickerDapp = dapp - , _testOpts = opts - } - v <- mkVty - _ <- customMain v mkVty Nothing (app opts) (ui :: UiState) - return () - -takeStep - :: (?fetcher :: Fetcher - ,?maxIter :: Maybe Integer) - => UiVmState - -> StepMode - -> EventM n (Next UiState) -takeStep ui mode = - liftIO nxt >>= \case - (Stopped (), ui') -> - continue (ViewVm ui') - (Continue steps, ui') -> do - continue (ViewVm (ui' & set uiStepper steps)) - where - m = interpret mode (view uiStepper ui) - nxt = runStateT m ui - -backstepUntil - :: (?fetcher :: Fetcher - ,?maxIter :: Maybe Integer) - => (UiVmState -> Pred VM) -> UiVmState -> EventM n (Next UiState) -backstepUntil p s = - case view uiStep s of - 0 -> continue (ViewVm s) - n -> do - s1 <- backstep s - let - -- find a previous vm that satisfies the predicate - snapshots' = Data.Map.filter (p s1 . fst) (view uiSnapshots s1) - case lookupLT n snapshots' of - -- If no such vm exists, go to the beginning - Nothing -> - let - (step', (vm', stepper')) = fromJust $ lookupLT (n - 1) (view uiSnapshots s) - s2 = s1 - & set uiVm vm' - & set (uiVm . cache) (view (uiVm . cache) s1) - & set uiStep step' - & set uiStepper stepper' - in takeStep s2 (Step 0) - -- step until the predicate doesn't hold - Just (step', (vm', stepper')) -> - let - s2 = s1 - & set uiVm vm' - & set (uiVm . cache) (view (uiVm . cache) s1) - & set uiStep step' - & set uiStepper stepper' - in takeStep s2 (StepUntil (not . p s1)) - -backstep - :: (?fetcher :: Fetcher - ,?maxIter :: Maybe Integer) - => UiVmState -> EventM n UiVmState -backstep s = case view uiStep s of - -- We're already at the first step; ignore command. - 0 -> return s - -- To step backwards, we revert to the previous snapshot - -- and execute n - 1 `mod` snapshotInterval steps from there. - - -- We keep the current cache so we don't have to redo - -- any blocking queries, and also the memory view. - n -> - let - (step, (vm, stepper)) = fromJust $ lookupLT n (view uiSnapshots s) - s1 = s - & set uiVm vm - & set (uiVm . cache) (view (uiVm . cache) s) - & set uiStep step - & set uiStepper stepper - stepsToTake = n - step - 1 - - in - liftIO $ runStateT (interpret (Step stepsToTake) stepper) s1 >>= \case - (Continue steps, ui') -> return $ ui' & set uiStepper steps - _ -> error "unexpected end" - -appEvent - :: (?fetcher::Fetcher, ?maxIter :: Maybe Integer) => - UiState -> - BrickEvent Name e -> - EventM Name (Next UiState) - --- Contracts: Down - list down -appEvent (ViewContracts s) (VtyEvent e@(V.EvKey V.KDown [])) = do - s' <- handleEventLensed s - browserContractList - handleListEvent - e - continue (ViewContracts s') - --- Contracts: Up - list up -appEvent (ViewContracts s) (VtyEvent e@(V.EvKey V.KUp [])) = do - s' <- handleEventLensed s - browserContractList - handleListEvent - e - continue (ViewContracts s') - --- Vm Overview: Esc - return to test picker or exit -appEvent st@(ViewVm s) (VtyEvent (V.EvKey V.KEsc [])) = - let opts = view uiTestOpts s - dapp' = dapp (view uiTestOpts s) - tests = concatMap - (debuggableTests opts) - (view dappUnitTests dapp') - in case tests of - [] -> halt st - ts -> - continue . ViewPicker $ - UiTestPickerState - { _testPickerList = - list - TestPickerPane - (Vec.fromList - ts) - 1 - , _testPickerDapp = dapp' - , _testOpts = opts - } - --- Vm Overview: Enter - open contracts view -appEvent (ViewVm s) (VtyEvent (V.EvKey V.KEnter [])) = - continue . ViewContracts $ UiBrowserState - { _browserContractList = - list - BrowserPane - (Vec.fromList (Map.toList (view (uiVm . env . contracts) s))) - 2 - , _browserVm = s - } - --- Vm Overview: m - toggle memory pane -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'm') [])) = - continue (ViewVm (over uiShowMemory not s)) - --- Vm Overview: h - open help view -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'h') [])) - = continue . ViewHelp $ s - --- Vm Overview: spacebar - read input -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar ' ') [])) = - let - loop = do - Readline.getInputLine "% " >>= \case - Just hey -> Readline.outputStrLn hey - Nothing -> pure () - Readline.getInputLine "% " >>= \case - Just hey' -> Readline.outputStrLn hey' - Nothing -> pure () - return (ViewVm s) - in - suspendAndResume $ - Readline.runInputT Readline.defaultSettings loop - --- todo refactor to zipper step forward --- Vm Overview: n - step -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'n') [])) = - if isJust $ view (uiVm . result) s - then continue (ViewVm s) - else takeStep s (Step 1) - --- Vm Overview: N - step -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'N') [])) = - if isJust $ view (uiVm . result) s - then continue (ViewVm s) - else takeStep s - (StepUntil (isNextSourcePosition s)) - --- Vm Overview: C-n - step -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'n') [V.MCtrl])) = - if isJust $ view (uiVm . result) s - then continue (ViewVm s) - else takeStep s - (StepUntil (isNextSourcePositionWithoutEntering s)) - --- Vm Overview: e - step -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'e') [])) = - if isJust $ view (uiVm . result) s - then continue (ViewVm s) - else takeStep s - (StepUntil (isExecutionHalted s)) - --- Vm Overview: a - step -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'a') [])) = - -- We keep the current cache so we don't have to redo - -- any blocking queries. - let - (vm, stepper) = fromJust (Map.lookup 0 (view uiSnapshots s)) - s' = s - & set uiVm vm - & set (uiVm . cache) (view (uiVm . cache) s) - & set uiStep 0 - & set uiStepper stepper - - in takeStep s' (Step 0) - --- Vm Overview: p - backstep -appEvent st@(ViewVm s) (VtyEvent (V.EvKey (V.KChar 'p') [])) = - case view uiStep s of - 0 -> - -- We're already at the first step; ignore command. - continue st - n -> do - -- To step backwards, we revert to the previous snapshot - -- and execute n - 1 `mod` snapshotInterval steps from there. - - -- We keep the current cache so we don't have to redo - -- any blocking queries, and also the memory view. - let - (step, (vm, stepper)) = fromJust $ lookupLT n (view uiSnapshots s) - s1 = s - & set uiVm vm -- set the vm to the one from the snapshot - & set (uiVm . cache) (view (uiVm . cache) s) -- persist the cache - & set uiStep step - & set uiStepper stepper - stepsToTake = n - step - 1 - - takeStep s1 (Step stepsToTake) - --- Vm Overview: P - backstep to previous source -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'P') [])) = - backstepUntil isNextSourcePosition s - --- Vm Overview: c-p - backstep to previous source avoiding CALL and CREATE -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar 'p') [V.MCtrl])) = - backstepUntil isNextSourcePositionWithoutEntering s - --- Vm Overview: 0 - choose no jump -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar '0') [])) = - case view (uiVm . result) s of - Just (VMFailure (Choose (PleaseChoosePath _ contin))) -> - takeStep (s & set uiStepper (Stepper.evm (contin True) >> (view uiStepper s))) - (Step 1) - _ -> continue (ViewVm s) - --- Vm Overview: 1 - choose jump -appEvent (ViewVm s) (VtyEvent (V.EvKey (V.KChar '1') [])) = - case view (uiVm . result) s of - Just (VMFailure (Choose (PleaseChoosePath _ contin))) -> - takeStep (s & set uiStepper (Stepper.evm (contin False) >> (view uiStepper s))) - (Step 1) - _ -> continue (ViewVm s) - - --- Any: Esc - return to Vm Overview or Exit -appEvent s (VtyEvent (V.EvKey V.KEsc [])) = - case s of - (ViewHelp x) -> overview x - (ViewContracts x) -> overview $ view browserVm x - _ -> halt s - where - overview = continue . ViewVm - --- UnitTest Picker: Enter - select from list -appEvent (ViewPicker s) (VtyEvent (V.EvKey V.KEnter [])) = - case listSelectedElement (view testPickerList s) of - Nothing -> error "nothing selected" - Just (_, x) -> do - initVm <- liftIO $ initialUiVmStateForTest (view testOpts s) x - continue . ViewVm $ initVm - --- UnitTest Picker: (main) - render list -appEvent (ViewPicker s) (VtyEvent e) = do - s' <- handleEventLensed s - testPickerList - handleListEvent - e - continue (ViewPicker s') - --- Page: Down - scroll -appEvent (ViewVm s) (VtyEvent (V.EvKey V.KDown [])) = - if view uiShowMemory s then - vScrollBy (viewportScroll TracePane) 1 >> continue (ViewVm s) - else - if isJust $ view (uiVm . result) s - then continue (ViewVm s) - else takeStep s - (StepUntil (isNewTraceAdded s)) - --- Page: Up - scroll -appEvent (ViewVm s) (VtyEvent (V.EvKey V.KUp [])) = - if view uiShowMemory s then - vScrollBy (viewportScroll TracePane) (-1) >> continue (ViewVm s) - else - backstepUntil isNewTraceAdded s - --- Page: C-f - Page down -appEvent s (VtyEvent (V.EvKey (V.KChar 'f') [V.MCtrl])) = - vScrollPage (viewportScroll TracePane) Down >> continue s - --- Page: C-b - Page up -appEvent s (VtyEvent (V.EvKey (V.KChar 'b') [V.MCtrl])) = - vScrollPage (viewportScroll TracePane) Up >> continue s - --- Default -appEvent s _ = continue s - -app :: UnitTestOptions -> App UiState () Name -app opts = - let ?fetcher = oracle opts - ?maxIter = maxIter opts - in App - { appDraw = drawUi - , appChooseCursor = neverShowCursor - , appHandleEvent = appEvent - , appStartEvent = return - , appAttrMap = const (attrMap V.defAttr myTheme) - } - -initialUiVmStateForTest - :: UnitTestOptions - -> (Text, Text) - -> IO UiVmState -initialUiVmStateForTest opts@UnitTestOptions{..} (theContractName, theTestName) = do - let state' = fromMaybe (error "Internal Error: missing smtState") smtState - (buf, len) <- case test of - SymbolicTest _ -> flip runReaderT state' $ SBV.runQueryT $ symCalldata theTestName types [] - _ -> return (error "unreachable", error "unreachable") - let script = do - Stepper.evm . pushTrace . EntryTrace $ - "test " <> theTestName <> " (" <> theContractName <> ")" - initializeUnitTest opts testContract - case test of - ConcreteTest _ -> do - let args = case replay of - Nothing -> emptyAbi - Just (sig, callData) -> - if theTestName == sig - then decodeAbiValue (AbiTupleType (Vec.fromList types)) callData - else emptyAbi - void (runUnitTest opts theTestName args) - SymbolicTest _ -> do - Stepper.evm $ modify symbolify - void (execSymTest opts theTestName (SymbolicBuffer buf, w256lit len)) - InvariantTest _ -> do - targets <- getTargetContracts opts - let randomRun = initialExplorationStepper opts theTestName [] targets (fromMaybe 20 maxDepth) - void $ case replay of - Nothing -> randomRun - Just (sig, cd) -> - if theTestName == sig - then initialExplorationStepper opts theTestName (decodeCalls cd) targets (length (decodeCalls cd)) - else randomRun - pure $ initUiVmState vm0 opts script - where - Just (test, types) = find (\(test',_) -> extractSig test' == theTestName) $ unitTestMethods testContract - Just testContract = - view (dappSolcByName . at theContractName) dapp - vm0 = - initialUnitTestVm opts testContract - -myTheme :: [(AttrName, V.Attr)] -myTheme = - [ (selectedAttr, V.defAttr `V.withStyle` V.standout) - , (dimAttr, V.defAttr `V.withStyle` V.dim) - , (borderAttr, V.defAttr `V.withStyle` V.dim) - , (wordAttr, fg V.yellow) - , (boldAttr, V.defAttr `V.withStyle` V.bold) - , (activeAttr, V.defAttr `V.withStyle` V.standout) - ] - -drawUi :: UiState -> [UiWidget] -drawUi (ViewVm s) = drawVm s -drawUi (ViewPicker s) = drawTestPicker s -drawUi (ViewContracts s) = drawVmBrowser s -drawUi (ViewHelp _) = drawHelpView - -drawHelpView :: [UiWidget] -drawHelpView = - [ center . borderWithLabel version . - padLeftRight 4 . padTopBottom 2 . str $ - "Esc Exit the debugger\n\n" <> - "a Step to start\n" <> - "e Step to end\n" <> - "n Step fwds by one instruction\n" <> - "N Step fwds to the next source position\n" <> - "C-n Step fwds to the next source position skipping CALL & CREATE\n" <> - "p Step back by one instruction\n\n" <> - "P Step back to the previous source position\n\n" <> - "C-p Step back to the previous source position skipping CALL & CREATE\n\n" <> - "m Toggle memory pane\n" <> - "0 Choose the branch which does not jump \n" <> - "1 Choose the branch which does jump \n" <> - "Down Step to next entry in the callstack / Scroll memory pane\n" <> - "Up Step to previous entry in the callstack / Scroll memory pane\n" <> - "C-f Page memory pane fwds\n" <> - "C-b Page memory pane back\n\n" <> - "Enter Contracts browser" - ] - where - version = - txt "Hevm " <+> - str (showVersion Paths.version) <+> - txt " - Key bindings" - -drawTestPicker :: UiTestPickerState -> [UiWidget] -drawTestPicker ui = - [ center . borderWithLabel (txt "Unit tests") . - hLimit 80 $ - renderList - (\selected (x, y) -> - withHighlight selected $ - txt " Debug " <+> txt (contractNamePart x) <+> txt "::" <+> txt y) - True - (view testPickerList ui) - ] - -drawVmBrowser :: UiBrowserState -> [UiWidget] -drawVmBrowser ui = - [ hBox - [ borderWithLabel (txt "Contracts") . - hLimit 60 $ - renderList - (\selected (k, c') -> - withHighlight selected . txt . mconcat $ - [ fromMaybe "" . flip preview dapp' $ - ( dappSolcByHash . ix (view codehash c') - . _2 . contractName ) - , "\n" - , " ", pack (show k) - ]) - True - (view browserContractList ui) - , case flip preview dapp' (dappSolcByHash . ix (view codehash c) . _2) of - Nothing -> - hBox - [ borderWithLabel (txt "Contract information") . padBottom Max . padRight Max $ vBox - [ txt ("Codehash: " <> pack (show (view codehash c))) - , txt ("Nonce: " <> showWordExact (view nonce c)) - , txt ("Balance: " <> showWordExact (view balance c)) - , txt ("Storage: " <> storageDisplay (view storage c)) - ] - ] - Just sol -> - hBox - [ borderWithLabel (txt "Contract information") . padBottom Max . padRight (Pad 2) $ vBox - [ txt "Name: " <+> txt (contractNamePart (view contractName sol)) - , txt "File: " <+> txt (contractPathPart (view contractName sol)) - , txt " " - , txt "Constructor inputs:" - , vBox . flip map (view constructorInputs sol) $ - \(name, abiType) -> txt (" " <> name <> ": " <> abiTypeSolidity abiType) - , txt "Public methods:" - , vBox . flip map (sort (Map.elems (view abiMap sol))) $ - \method -> txt (" " <> view methodSignature method) - , txt ("Storage:" <> storageDisplay (view storage c)) - ] - , borderWithLabel (txt "Storage slots") . padBottom Max . padRight Max $ vBox - (map txt (storageLayout dapp' sol)) - ] - ] - ] - where storageDisplay (Concrete s) = pack ( show ( Map.toList s)) - storageDisplay (Symbolic v _) = pack $ show v - dapp' = dapp (view (browserVm . uiTestOpts) ui) - Just (_, (_, c)) = listSelectedElement (view browserContractList ui) --- currentContract = view (dappSolcByHash . ix ) dapp - -drawVm :: UiVmState -> [UiWidget] -drawVm ui = - -- EVM debugging needs a lot of space because of the 256-bit words - -- in both the bytecode and the stack . - -- - -- If on a very tall display, prefer a vertical layout. - -- - -- Actually the horizontal layout would be preferrable if the display - -- is both very tall and very wide, but this is okay for now. - [ ifTallEnough (20 * 4) - ( vBox - [ vLimit 20 $ drawBytecodePane ui - , vLimit 20 $ drawStackPane ui - , drawSolidityPane ui - , vLimit 20 $ drawTracePane ui - , vLimit 2 drawHelpBar - ] - ) - ( vBox - [ hBox - [ vLimit 20 $ drawBytecodePane ui - , vLimit 20 $ drawStackPane ui - ] - , hBox - [ drawSolidityPane ui - , drawTracePane ui - ] - , vLimit 2 drawHelpBar - ] - ) - ] - -drawHelpBar :: UiWidget -drawHelpBar = hBorder <=> hCenter help - where - help = - hBox (map (\(k, v) -> txt k <+> dim (txt (" (" <> v <> ") "))) helps) - - helps = - [ - ("n", "step") - , ("p", "step back") - , ("a", "step to start") - , ("e", "step to end") - , ("m", "toggle memory") - , ("Esc", "exit") - , ("h", "more help") - ] - -stepOneOpcode :: Stepper a -> StateT UiVmState IO () -stepOneOpcode restart = do - n <- use uiStep - when (n > 0 && n `mod` snapshotInterval == 0) $ do - vm <- use uiVm - modifying uiSnapshots (insert n (vm, void restart)) - modifying uiVm (execState exec1) - modifying uiStep (+ 1) - -isNewTraceAdded - :: UiVmState -> Pred VM -isNewTraceAdded ui vm = - let - currentTraceTree = length <$> traceForest (view uiVm ui) - newTraceTree = length <$> traceForest vm - in currentTraceTree /= newTraceTree - -isNextSourcePosition - :: UiVmState -> Pred VM -isNextSourcePosition ui vm = - let dapp' = dapp (view uiTestOpts ui) - initialPosition = currentSrcMap dapp' (view uiVm ui) - in currentSrcMap dapp' vm /= initialPosition - -isNextSourcePositionWithoutEntering - :: UiVmState -> Pred VM -isNextSourcePositionWithoutEntering ui vm = - let - dapp' = dapp (view uiTestOpts ui) - vm0 = view uiVm ui - initialPosition = currentSrcMap dapp' vm0 - initialHeight = length (view frames vm0) - in - case currentSrcMap dapp' vm of - Nothing -> - False - Just here -> - let - moved = Just here /= initialPosition - deeper = length (view frames vm) > initialHeight - boring = - case srcMapCode (view dappSources dapp') here of - Just bs -> - BS.isPrefixOf "contract " bs - Nothing -> - True - in - moved && not deeper && not boring - -isExecutionHalted :: UiVmState -> Pred VM -isExecutionHalted _ vm = isJust (view result vm) - -currentSrcMap :: DappInfo -> VM -> Maybe SrcMap -currentSrcMap dapp vm = do - this <- currentContract vm - i <- (view opIxMap this) SVec.!? (view (state . pc) vm) - srcMap dapp this i - -drawStackPane :: UiVmState -> UiWidget -drawStackPane ui = - let - gasText = showWordExact (view (uiVm . state . gas) ui) - labelText = txt ("Gas available: " <> gasText <> "; stack:") - stackList = list StackPane (Vec.fromList $ zip [(1 :: Int)..] (view (uiVm . state . stack) ui)) 2 - in hBorderWithLabel labelText <=> - renderList - (\_ (i, x@(S _ w)) -> - vBox - [ withHighlight True (str ("#" ++ show i ++ " ")) - <+> str (show x) - , dim (txt (" " <> case unliteral w of - Nothing -> "" - Just u -> showWordExplanation (fromSizzle u) $ dapp (view uiTestOpts ui))) - ]) - False - stackList - -message :: VM -> String -message vm = - case view result vm of - Just (VMSuccess (ConcreteBuffer msg)) -> - "VMSuccess: " <> (show $ ByteStringS msg) - Just (VMSuccess (SymbolicBuffer msg)) -> - "VMSuccess: " <> (show msg) - Just (VMFailure (Revert msg)) -> - "VMFailure: " <> (show . ByteStringS $ msg) - Just (VMFailure err) -> - "VMFailure: " <> show err - Nothing -> - "Executing EVM code in " <> show (view (state . contract) vm) - - -drawBytecodePane :: UiVmState -> UiWidget -drawBytecodePane ui = - let - vm = view uiVm ui - move = maybe id listMoveTo $ vmOpIx vm - in - hBorderWithLabel (str $ message vm) <=> - Centered.renderList - (\active x -> if not active - then withDefAttr dimAttr (opWidget x) - else withDefAttr boldAttr (opWidget x)) - False - (move $ list BytecodePane - (maybe mempty (view codeOps) (currentContract vm)) - 1) - - -dim :: Widget n -> Widget n -dim = withDefAttr dimAttr - -withHighlight :: Bool -> Widget n -> Widget n -withHighlight False = withDefAttr dimAttr -withHighlight True = withDefAttr boldAttr - -prettyIfConcrete :: Buffer -> String -prettyIfConcrete (SymbolicBuffer x) = show x -prettyIfConcrete (ConcreteBuffer x) = prettyHex 40 x - -drawTracePane :: UiVmState -> UiWidget -drawTracePane s = - let vm = view uiVm s - dapp' = dapp (view uiTestOpts s) - traceList = - list - TracePane - (Vec.fromList - . Text.lines - . showTraceTree dapp' - $ vm) - 1 - - in case view uiShowMemory s of - True -> - hBorderWithLabel (txt "Calldata") - <=> str (prettyIfConcrete $ fst (view (state . calldata) vm)) - <=> hBorderWithLabel (txt "Returndata") - <=> str (prettyIfConcrete (view (state . returndata) vm)) - <=> hBorderWithLabel (txt "Output") - <=> str (maybe "" show (view result vm)) - <=> hBorderWithLabel (txt "Cache") - <=> str (show (view (cache . path) vm)) - <=> hBorderWithLabel (txt "Path Conditions") - <=> (str $ show $ snd <$> view constraints vm) - <=> hBorderWithLabel (txt "Memory") - <=> viewport TracePane Vertical - (str (prettyIfConcrete (view (state . memory) vm))) - False -> - hBorderWithLabel (txt "Trace") - <=> renderList - (\_ x -> txt x) - False - (listMoveTo (length traceList) traceList) - -solidityList :: VM -> DappInfo -> List Name (Int, ByteString) -solidityList vm dapp' = - list SolidityPane - (case currentSrcMap dapp' vm of - Nothing -> mempty - Just x -> - view (dappSources - . sourceLines - . ix (srcMapFile x) - . to (Vec.imap (,))) - dapp') - 1 - -drawSolidityPane :: UiVmState -> UiWidget -drawSolidityPane ui = - let dapp' = dapp (view uiTestOpts ui) - dappSrcs = view dappSources dapp' - vm = view uiVm ui - in case currentSrcMap dapp' vm of - Nothing -> padBottom Max (hBorderWithLabel (txt "")) - Just sm -> - let - rows = (_sourceLines dappSrcs) !! srcMapFile sm - subrange = lineSubrange rows (srcMapOffset sm, srcMapLength sm) - fileName :: Maybe Text - fileName = preview (dappSources . sourceFiles . ix (srcMapFile sm) . _1) dapp' - lineNo :: Maybe Int - lineNo = maybe Nothing (\a -> Just (a - 1)) - (snd <$> - (srcMapCodePos - (view dappSources dapp') - sm)) - in vBox - [ hBorderWithLabel $ - txt (fromMaybe "" fileName) - <+> str (":" ++ show lineNo) - - -- Show the AST node type if present - <+> txt (" (" <> fromMaybe "?" - ((view dappAstSrcMap dapp') sm - >>= preview (key "name" . _String)) <> ")") - , Centered.renderList - (\_ (i, line) -> - let s = case decodeUtf8 line of "" -> " "; y -> y - in case subrange i of - Nothing -> withHighlight False (txt s) - Just (a, b) -> - let (x, y, z) = ( Text.take a s - , Text.take b (Text.drop a s) - , Text.drop (a + b) s - ) - in hBox [ withHighlight False (txt x) - , withHighlight True (txt y) - , withHighlight False (txt z) - ]) - False - ((maybe id listMoveTo lineNo) - (solidityList vm dapp')) - ] - -ifTallEnough :: Int -> Widget n -> Widget n -> Widget n -ifTallEnough need w1 w2 = - Widget Greedy Greedy $ do - c <- getContext - if view availHeightL c > need - then render w1 - else render w2 - -opWidget :: (Integral a, Show a) => (a, Op) -> Widget n -opWidget = txt . pack . opString - -selectedAttr :: AttrName; selectedAttr = "selected" -dimAttr :: AttrName; dimAttr = "dim" -wordAttr :: AttrName; wordAttr = "word" -boldAttr :: AttrName; boldAttr = "bold" -activeAttr :: AttrName; activeAttr = "active" diff --git a/src/hevm/src/EVM/TTYCenteredList.hs b/src/hevm/src/EVM/TTYCenteredList.hs deleted file mode 100644 index fe408dc5b..000000000 --- a/src/hevm/src/EVM/TTYCenteredList.hs +++ /dev/null @@ -1,71 +0,0 @@ -module EVM.TTYCenteredList where - --- Hard fork of brick's List that centers the currently highlighted line. - -import Control.Lens -import Data.Maybe (fromMaybe) - -import Brick.Types -import Brick.Widgets.Core -import Brick.Widgets.List - -import qualified Data.Vector as V - --- | Turn a list state value into a widget given an item drawing --- function. -renderList :: (Ord n, Show n) - => (Bool -> e -> Widget n) - -- ^ Rendering function, True for the selected element - -> Bool - -- ^ Whether the list has focus - -> List n e - -- ^ The List to be rendered - -> Widget n - -- ^ rendered widget -renderList drawElem foc l = - withDefAttr listAttr $ - drawListElements foc l drawElem - -drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Bool -> e -> Widget n) -> Widget n -drawListElements foc l drawElem = - Widget Greedy Greedy $ do - c <- getContext - - let es = V.slice start num (l^.listElementsL) - idx = fromMaybe 0 (l^.listSelectedL) - - start = max 0 $ idx - (initialNumPerHeight `div` 2) - num = min (numPerHeight * 2) (V.length (l^.listElementsL) - start) - - -- The number of items to show is the available height divided by - -- the item height... - initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL) - -- ... but if the available height leaves a remainder of - -- an item height then we need to ensure that we render an - -- extra item to show a partial item at the top or bottom to - -- give the expected result when an item is more than one - -- row high. (Example: 5 rows available with item height - -- of 3 yields two items: one fully rendered, the other - -- rendered with only its top 2 or bottom 2 rows visible, - -- depending on how the viewport state changes.) - numPerHeight = initialNumPerHeight + - if initialNumPerHeight * (l^.listItemHeightL) == c^.availHeightL - then 0 - else 1 - - -- off = start * (l^.listItemHeightL) - - drawnElements = flip V.imap es $ \i e -> - let isSelected = i == (if start == 0 then idx else div initialNumPerHeight 2) - elemWidget = drawElem isSelected e - selItemAttr = if foc - then withDefAttr listSelectedFocusedAttr - else withDefAttr listSelectedAttr - makeVisible = if isSelected - then visible . selItemAttr - else id - in makeVisible elemWidget - - render $ viewport (l^.listNameL) Vertical $ - -- translateBy (Location (0, off)) $ - vBox $ V.toList drawnElements diff --git a/src/hevm/src/EVM/Transaction.hs b/src/hevm/src/EVM/Transaction.hs deleted file mode 100644 index 3ff0e0ce1..000000000 --- a/src/hevm/src/EVM/Transaction.hs +++ /dev/null @@ -1,224 +0,0 @@ -module EVM.Transaction where - -import Prelude hiding (Word) - -import qualified EVM -import EVM (balance, initialContract) -import EVM.FeeSchedule -import EVM.Precompiled (execute) -import EVM.RLP -import EVM.Symbolic (forceLit) -import EVM.Types - -import Control.Lens - -import Data.Aeson (FromJSON (..)) -import Data.ByteString (ByteString) -import Data.Map (Map) -import Data.Maybe (fromMaybe, isNothing, isJust) - -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Types as JSON -import qualified Data.ByteString as BS -import qualified Data.Map as Map - -data AccessListEntry = AccessListEntry { - accessAddress :: Addr, - accessStorageKeys :: [W256] -} deriving Show - -data TxType = LegacyTransaction - | AccessListTransaction - | EIP1559Transaction - deriving (Show, Eq) - -data Transaction = Transaction { - txData :: ByteString, - txGasLimit :: W256, - txGasPrice :: Maybe W256, - txNonce :: W256, - txR :: W256, - txS :: W256, - txToAddr :: Maybe Addr, - txV :: W256, - txValue :: W256, - txType :: TxType, - txAccessList :: [AccessListEntry], - txMaxPriorityFeeGas :: Maybe W256, - txMaxFeePerGas :: Maybe W256 -} deriving Show - --- | utility function for getting a more useful representation of accesslistentries --- duplicates only matter for gas computation -txAccessMap :: Transaction -> Map Addr [W256] -txAccessMap tx = ((Map.fromListWith (++)) . makeTups) $ txAccessList tx - where makeTups = map (\ale -> (accessAddress ale, accessStorageKeys ale)) - -ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr -ecrec v r s e = num . word <$> EVM.Precompiled.execute 1 input 32 - where input = BS.concat (word256Bytes <$> [e, v, r, s]) - -sender :: Int -> Transaction -> Maybe Addr -sender chainId tx = ecrec v' (txR tx) (txS tx) hash - where hash = keccak (signingData chainId tx) - v = txV tx - v' = if v == 27 || v == 28 then v - else 27 + v - -signingData :: Int -> Transaction -> ByteString -signingData chainId tx = - case txType tx of - LegacyTransaction -> if v == (chainId * 2 + 35) || v == (chainId * 2 + 36) - then eip155Data - else normalData - AccessListTransaction -> eip2930Data - EIP1559Transaction -> eip1559Data - where v = fromIntegral (txV tx) - to' = case txToAddr tx of - Just a -> BS $ word160Bytes a - Nothing -> BS mempty - Just maxFee = txMaxFeePerGas tx - Just maxPrio = txMaxPriorityFeeGas tx - Just gasPrice = txGasPrice tx - accessList = txAccessList tx - rlpAccessList = EVM.RLP.List $ map (\accessEntry -> - EVM.RLP.List [BS $ word160Bytes (accessAddress accessEntry), - EVM.RLP.List $ map rlpWordFull $ accessStorageKeys accessEntry] - ) accessList - normalData = rlpList [rlpWord256 (txNonce tx), - rlpWord256 gasPrice, - rlpWord256 (txGasLimit tx), - to', - rlpWord256 (txValue tx), - BS (txData tx)] - eip155Data = rlpList [rlpWord256 (txNonce tx), - rlpWord256 gasPrice, - rlpWord256 (txGasLimit tx), - to', - rlpWord256 (txValue tx), - BS (txData tx), - rlpWord256 (fromIntegral chainId), - rlpWord256 0x0, - rlpWord256 0x0] - eip1559Data = cons 0x02 $ rlpList [ - rlpWord256 (fromIntegral chainId), - rlpWord256 (txNonce tx), - rlpWord256 maxPrio, - rlpWord256 maxFee, - rlpWord256 (txGasLimit tx), - to', - rlpWord256 (txValue tx), - BS (txData tx), - rlpAccessList] - - eip2930Data = cons 0x01 $ rlpList [ - rlpWord256 (fromIntegral chainId), - rlpWord256 (txNonce tx), - rlpWord256 gasPrice, - rlpWord256 (txGasLimit tx), - to', - rlpWord256 (txValue tx), - BS (txData tx), - rlpAccessList] - -accessListPrice :: FeeSchedule Integer -> [AccessListEntry] -> Integer -accessListPrice fs al = - sum (map - (\ale -> - g_access_list_address fs + - (g_access_list_storage_key fs * (toInteger . length) (accessStorageKeys ale))) - al) - -txGasCost :: FeeSchedule Integer -> Transaction -> Integer -txGasCost fs tx = - let calldata = txData tx - zeroBytes = BS.count 0 calldata - nonZeroBytes = BS.length calldata - zeroBytes - baseCost = g_transaction fs - + (if isNothing (txToAddr tx) then g_txcreate fs else 0) - + (accessListPrice fs $ txAccessList tx) - zeroCost = g_txdatazero fs - nonZeroCost = g_txdatanonzero fs - in baseCost + zeroCost * (fromIntegral zeroBytes) + nonZeroCost * (fromIntegral nonZeroBytes) - -instance FromJSON AccessListEntry where - parseJSON (JSON.Object val) = do - accessAddress_ <- addrField val "address" - accessStorageKeys_ <- (val JSON..: "storageKeys") >>= parseJSONList - return $ AccessListEntry accessAddress_ accessStorageKeys_ - parseJSON invalid = - JSON.typeMismatch "AccessListEntry" invalid - -instance FromJSON Transaction where - parseJSON (JSON.Object val) = do - tdata <- dataField val "data" - gasLimit <- wordField val "gasLimit" - gasPrice <- fmap read <$> val JSON..:? "gasPrice" - maxPrio <- fmap read <$> val JSON..:? "maxPriorityFeePerGas" - maxFee <- fmap read <$> val JSON..:? "maxFeePerGas" - nonce <- wordField val "nonce" - r <- wordField val "r" - s <- wordField val "s" - toAddr <- addrFieldMaybe val "to" - v <- wordField val "v" - value <- wordField val "value" - txType <- fmap read <$> (val JSON..:? "type") - case txType of - Just 0x00 -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value LegacyTransaction [] Nothing Nothing - Just 0x01 -> do - accessListEntries <- (val JSON..: "accessList") >>= parseJSONList - return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value AccessListTransaction accessListEntries Nothing Nothing - Just 0x02 -> do - accessListEntries <- (val JSON..: "accessList") >>= parseJSONList - return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value EIP1559Transaction accessListEntries maxPrio maxFee - Just _ -> fail "unrecognized custom transaction type" - Nothing -> return $ Transaction tdata gasLimit gasPrice nonce r s toAddr v value LegacyTransaction [] Nothing Nothing - parseJSON invalid = - JSON.typeMismatch "Transaction" invalid - -accountAt :: Addr -> Getter (Map Addr EVM.Contract) EVM.Contract -accountAt a = (at a) . (to $ fromMaybe newAccount) - -touchAccount :: Addr -> Map Addr EVM.Contract -> Map Addr EVM.Contract -touchAccount a = Map.insertWith (flip const) a newAccount - -newAccount :: EVM.Contract -newAccount = initialContract $ EVM.RuntimeCode mempty - --- | Increments origin nonce and pays gas deposit -setupTx :: Addr -> Addr -> Word -> Word -> Map Addr EVM.Contract -> Map Addr EVM.Contract -setupTx origin coinbase gasPrice gasLimit prestate = - let gasCost = gasPrice * gasLimit - in (Map.adjust ((over EVM.nonce (+ 1)) - . (over balance (subtract gasCost))) origin) - . touchAccount origin - . touchAccount coinbase $ prestate - --- | Given a valid tx loaded into the vm state, --- subtract gas payment from the origin, increment the nonce --- and pay receiving address -initTx :: EVM.VM -> EVM.VM -initTx vm = let - toAddr = view (EVM.state . EVM.contract) vm - origin = view (EVM.tx . EVM.origin) vm - gasPrice = view (EVM.tx . EVM.gasprice) vm - gasLimit = view (EVM.tx . EVM.txgaslimit) vm - coinbase = view (EVM.block . EVM.coinbase) vm - value = view (EVM.state . EVM.callvalue) vm - toContract = initialContract (EVM.InitCode (view (EVM.state . EVM.code) vm)) - preState = setupTx origin coinbase gasPrice gasLimit $ view (EVM.env . EVM.contracts) vm - oldBalance = view (accountAt toAddr . balance) preState - creation = view (EVM.tx . EVM.isCreate) vm - initState = - (if isJust (maybeLitWord value) - then (Map.adjust (over balance (subtract (forceLit value))) origin) - . (Map.adjust (over balance (+ (forceLit value))) toAddr) - else id) - . (if creation - then Map.insert toAddr (toContract & balance .~ oldBalance) - else touchAccount toAddr) - $ preState - - in - vm & EVM.env . EVM.contracts .~ initState - & EVM.tx . EVM.txReversion .~ preState diff --git a/src/hevm/src/EVM/Types.hs b/src/hevm/src/EVM/Types.hs deleted file mode 100644 index fdd2368de..000000000 --- a/src/hevm/src/EVM/Types.hs +++ /dev/null @@ -1,575 +0,0 @@ -{-# Language CPP #-} -{-# Language TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleInstances #-} - -module EVM.Types where - -import Prelude hiding (Word, LT, GT) - -import Data.Aeson -import Crypto.Hash -import Data.SBV hiding (Word) -import Data.Kind -import Data.Bifunctor (first) -import Data.Char -import Data.List (intercalate) -import Data.ByteString (ByteString) -import Data.ByteString.Base16 as BS16 -import Data.ByteString.Builder (byteStringHex, toLazyByteString) -import Data.ByteString.Lazy (toStrict) -import Control.Monad.State.Strict (liftM) -import qualified Data.ByteString.Char8 as Char8 -import Data.DoubleWord -import Data.DoubleWord.TH -import Data.Maybe (fromMaybe) -import Numeric (readHex, showHex) -import Options.Generic -import Control.Arrow ((>>>)) - -import qualified Data.ByteArray as BA -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Types as JSON -import qualified Data.ByteString as BS -import qualified Data.Serialize.Get as Cereal -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Sequence as Seq -import qualified Text.Regex.TDFA as Regex -import qualified Text.Read - --- Some stuff for "generic programming", needed to create Word512 -import Data.Data - --- We need a 512-bit word for doing ADDMOD and MULMOD with full precision. -mkUnpackedDoubleWord "Word512" ''Word256 "Int512" ''Int256 ''Word256 - [''Typeable, ''Data, ''Generic] - - -data Buffer - = ConcreteBuffer ByteString - | SymbolicBuffer [SWord 8] - -newtype W256 = W256 Word256 - deriving - ( Num, Integral, Real, Ord, Enum, Eq - , Bits, FiniteBits, Bounded, Generic - ) - -data Word = C Whiff W256 --maybe to remove completely in the future - -instance Show Word where - show (C _ x) = show x - -instance Read Word where - readsPrec n s = - case readsPrec n s of - [(x, r)] -> [(C (Literal x) x, r)] - _ -> [] - -w256 :: W256 -> Word -w256 w = C (Literal w) w - -instance Bits Word where - (C a x) .&. (C b y) = C (And a b) (x .&. y) - (C a x) .|. (C b y) = C (Or a b) (x .|. y) - (C a x) `xor` (C b y) = C (Todo "xor" [a, b]) (x `xor` y) - complement (C a x) = C (Neg a) (complement x) - shiftL (C a x) i = C (SHL a (Literal $ fromIntegral i)) (shiftL x i) - shiftR (C a x) i = C (SHR a (Literal $ fromIntegral i)) (shiftR x i) - rotate (C a x) i = C (Todo "rotate " [a]) (rotate x i) -- unused. - bitSize (C _ x) = bitSize x - bitSizeMaybe (C _ x) = bitSizeMaybe x - isSigned (C _ x) = isSigned x - testBit (C _ x) i = testBit x i - bit i = w256 (bit i) - popCount (C _ x) = popCount x - -instance FiniteBits Word where - finiteBitSize (C _ x) = finiteBitSize x - countLeadingZeros (C _ x) = countLeadingZeros x - countTrailingZeros (C _ x) = countTrailingZeros x - -instance Bounded Word where - minBound = w256 minBound - maxBound = w256 maxBound - -instance Eq Word where - (C _ x) == (C _ y) = x == y - -instance Enum Word where - toEnum i = w256 (toEnum i) - fromEnum (C _ x) = fromEnum x - -instance Integral Word where - quotRem (C _ x) (C _ y) = - let (a, b) = quotRem x y - in (w256 a, w256 b) - toInteger (C _ x) = toInteger x - -instance Num Word where - (C a x) + (C b y) = C (Add a b) (x + y) - (C a x) * (C b y) = C (Mul a b) (x * y) - abs (C a x) = C (Todo "abs" [a]) (abs x) - signum (C a x) = C (Todo "signum" [a]) (signum x) - fromInteger x = C (Literal (fromInteger x)) (fromInteger x) - negate (C a x) = C (Sub (Literal 0) a) (negate x) - -instance Real Word where - toRational (C _ x) = toRational x - -instance Ord Word where - compare (C _ x) (C _ y) = compare x y - -newtype ByteStringS = ByteStringS ByteString deriving (Eq) - -instance Show ByteStringS where - show (ByteStringS x) = ("0x" ++) . Text.unpack . fromBinary $ x - where - fromBinary = - Text.decodeUtf8 . toStrict . toLazyByteString . byteStringHex - -instance JSON.ToJSON ByteStringS where - toJSON = JSON.String . Text.pack . show - --- | Symbolic words of 256 bits, possibly annotated with additional --- "insightful" information -data SymWord = S Whiff (SWord 256) - -instance Show SymWord where - show (S w _) = show w - -var :: String -> SWord 256 -> SymWord -var name x = S (Var name x) x - --- | Custom instances for SymWord, many of which have direct --- analogues for concrete words defined in Concrete.hs -instance EqSymbolic SymWord where - (.==) (S _ x) (S _ y) = x .== y - -instance Num SymWord where - (S a x) + (S b y) = S (Add a b) (x + y) - (S a x) * (S b y) = S (Mul a b) (x * y) - abs (S a x) = S (Todo "abs" [a]) (abs x) - signum (S a x) = S (Todo "signum" [a]) (signum x) - fromInteger x = S (Literal (fromInteger x)) (fromInteger x) - negate (S a x) = S (Neg a) (negate x) - -instance Bits SymWord where - (S a x) .&. (S b y) = S (And a b) (x .&. y) - (S a x) .|. (S b y) = S (Or a b) (x .|. y) - (S a x) `xor` (S b y) = S (Todo "xor" [a, b]) (x `xor` y) - complement (S a x) = S (Neg a) (complement x) - shiftL (S a x) i = S (SHL a (Literal $ fromIntegral i)) (shiftL x i) - shiftR (S a x) i = S (SHR a (Literal $ fromIntegral i)) (shiftR x i) - rotate (S a x) i = S (Todo "rotate " [a]) (rotate x i) -- unused. - bitSize (S _ x) = bitSize x - bitSizeMaybe (S _ x) = bitSizeMaybe x - isSigned (S _ x) = isSigned x - testBit (S _ x) i = testBit x i - bit i = w256lit (bit i) - popCount (S _ x) = popCount x - --- sQuotRem and sDivMod are identical for SWord 256 --- prove $ \x y -> x `sQuotRem` (y :: SWord 256) .== x `sDivMod` y --- Q.E.D. -instance SDivisible SymWord where - sQuotRem (S x' x) (S y' y) = let (a, b) = x `sQuotRem` y - in (S (Div x' y') a, S (Mod x' y') b) - sDivMod = sQuotRem - --- | Instead of supporting a Mergeable instance directly, --- we use one which carries the Whiff around: -iteWhiff :: Whiff -> SBool -> SWord 256 -> SWord 256 -> SymWord -iteWhiff w b x y = S w (ite b x y) - -instance Bounded SymWord where - minBound = w256lit minBound - maxBound = w256lit maxBound - -instance Eq SymWord where - (S _ x) == (S _ y) = x == y - -instance Enum SymWord where - toEnum i = w256lit (toEnum i) - fromEnum (S _ x) = fromEnum x - --- | This type can give insight into the provenance of a term --- which is useful, both for the aesthetic purpose of printing --- terms in a richer way, but also do optimizations on the AST --- instead of letting the SMT solver do all the heavy lifting. -data Whiff = - Todo String [Whiff] - -- booleans / bits - | And Whiff Whiff - | Or Whiff Whiff - | Eq Whiff Whiff - | LT Whiff Whiff - | GT Whiff Whiff - | SLT Whiff Whiff - | SGT Whiff Whiff - | IsZero Whiff - | ITE Whiff Whiff Whiff - -- bits - | SHL Whiff Whiff - | SHR Whiff Whiff - | SAR Whiff Whiff - - -- integers - | Add Whiff Whiff - | Sub Whiff Whiff - | Mul Whiff Whiff - | Div Whiff Whiff - | Mod Whiff Whiff - | Exp Whiff Whiff - | Neg Whiff - | FromKeccak Buffer - | FromBytes Buffer - | FromStorage Whiff (SArray (WordN 256) (WordN 256)) - | Literal W256 - | Var String (SWord 256) - -instance Show Whiff where - show w = - let - infix' s x y = show x ++ s ++ show y - in case w of - Todo s args -> s ++ "(" ++ (intercalate "," (show <$> args)) ++ ")" - And x y -> infix' " and " x y - Or x y -> infix' " or " x y - ITE b x y -> "if " ++ show b ++ " then " ++ show x ++ " else " ++ show y - Eq x y -> infix' " == " x y - LT x y -> infix' " < " x y - GT x y -> infix' " > " x y - SLT x y -> infix' " s< " x y - SGT x y -> infix' " s> " x y - IsZero x -> "IsZero(" ++ show x ++ ")" - SHL x y -> infix' " << " x y - SHR x y -> infix' " >> " x y - SAR x y -> infix' " a>> " x y - Add x y -> infix' " + " x y - Sub x y -> infix' " - " x y - Mul x y -> infix' " * " x y - Div x y -> infix' " / " x y - Mod x y -> infix' " % " x y - Exp x y -> infix' " ** " x y - Neg x -> "not " ++ show x - Var v _ -> v - FromKeccak buf -> "keccak(" ++ show buf ++ ")" - Literal x -> show x - FromBytes buf -> "FromBuffer " ++ show buf - FromStorage l _ -> "SLOAD(" ++ show l ++ ")" - -newtype Addr = Addr { addressWord160 :: Word160 } - deriving (Num, Integral, Real, Ord, Enum, Eq, Bits, Generic) - -newtype SAddr = SAddr { saddressWord160 :: SWord 160 } - deriving (Num) - --- | Capture the correspondence between sized and fixed-sized BVs --- (This is blatant copypasta of `FromSized` from sbv, which just --- happens to be defined up to 64 bits) -type family FromSizzle (t :: Type) :: Type where - FromSizzle (WordN 256) = W256 - FromSizzle (WordN 160) = Addr - --- | Conversion from a sized BV to a fixed-sized bit-vector. -class FromSizzleBV a where - -- | Convert a sized bit-vector to the corresponding fixed-sized bit-vector, - -- for instance 'SWord 16' to 'SWord16'. See also 'toSized'. - fromSizzle :: a -> FromSizzle a - - default fromSizzle :: (Num (FromSizzle a), Integral a) => a -> FromSizzle a - fromSizzle = fromIntegral - - -maybeLitWord :: SymWord -> Maybe Word -maybeLitWord (S whiff a) = fmap (C whiff . fromSizzle) (unliteral a) - --- | convert between (WordN 256) and Word256 -type family ToSizzle (t :: Type) :: Type where - ToSizzle W256 = (WordN 256) - ToSizzle Addr = (WordN 160) - --- | Conversion from a fixed-sized BV to a sized bit-vector. -class ToSizzleBV a where - -- | Convert a fixed-sized bit-vector to the corresponding sized bit-vector, - toSizzle :: a -> ToSizzle a - - default toSizzle :: (Num (ToSizzle a), Integral a) => (a -> ToSizzle a) - toSizzle = fromIntegral - - -instance (ToSizzleBV W256) -instance (FromSizzleBV (WordN 256)) -instance (ToSizzleBV Addr) -instance (FromSizzleBV (WordN 160)) - -w256lit :: W256 -> SymWord -w256lit x = S (Literal x) $ literal $ toSizzle x - -litBytes :: ByteString -> [SWord 8] -litBytes bs = fmap (toSized . literal) (BS.unpack bs) - --- | Operations over buffers (concrete or symbolic) - --- | A buffer is a list of bytes. For concrete execution, this is simply `ByteString`. --- In symbolic settings, it is a list of symbolic bitvectors of size 8. -instance Show Buffer where - show (ConcreteBuffer b) = show $ ByteStringS b - show (SymbolicBuffer b) = show (length b) ++ " bytes" - - -instance Semigroup Buffer where - ConcreteBuffer a <> ConcreteBuffer b = ConcreteBuffer (a <> b) - ConcreteBuffer a <> SymbolicBuffer b = SymbolicBuffer (litBytes a <> b) - SymbolicBuffer a <> ConcreteBuffer b = SymbolicBuffer (a <> litBytes b) - SymbolicBuffer a <> SymbolicBuffer b = SymbolicBuffer (a <> b) - -instance Monoid Buffer where - mempty = ConcreteBuffer mempty - -instance EqSymbolic Buffer where - ConcreteBuffer a .== ConcreteBuffer b = literal (a == b) - ConcreteBuffer a .== SymbolicBuffer b = litBytes a .== b - SymbolicBuffer a .== ConcreteBuffer b = a .== litBytes b - SymbolicBuffer a .== SymbolicBuffer b = a .== b - - -instance Read W256 where - readsPrec _ "0x" = [(0, "")] - readsPrec n s = first W256 <$> readsPrec n s - -instance Show W256 where - showsPrec _ s = ("0x" ++) . showHex s - -instance JSON.ToJSON W256 where - toJSON = JSON.String . Text.pack . show - -instance JSON.ToJSON Word where - toJSON (C _ x) = toJSON x - -instance Read Addr where - readsPrec _ ('0':'x':s) = readHex s - readsPrec _ s = readHex s - -instance Show Addr where - showsPrec _ addr next = - let hex = showHex addr next - str = replicate (40 - length hex) '0' ++ hex - in "0x" ++ toChecksumAddress str ++ drop 40 str - -instance Show SAddr where - show (SAddr a) = case unliteral a of - Nothing -> "" - Just c -> show $ fromSizzle c - --- https://eips.ethereum.org/EIPS/eip-55 -toChecksumAddress :: String -> String -toChecksumAddress addr = zipWith transform nibbles addr - where - nibbles = unpackNibbles . BS.take 20 $ keccakBytes (Char8.pack addr) - transform nibble = if nibble >= 8 then toUpper else id - -strip0x :: ByteString -> ByteString -strip0x bs = if "0x" `Char8.isPrefixOf` bs then Char8.drop 2 bs else bs - -instance FromJSON W256 where - parseJSON v = do - s <- Text.unpack <$> parseJSON v - case reads s of - [(x, "")] -> return x - _ -> fail $ "invalid hex word (" ++ s ++ ")" - -instance FromJSON Addr where - parseJSON v = do - s <- Text.unpack <$> parseJSON v - case reads s of - [(x, "")] -> return x - _ -> fail $ "invalid address (" ++ s ++ ")" - -#if MIN_VERSION_aeson(1, 0, 0) - -instance FromJSONKey W256 where - fromJSONKey = FromJSONKeyTextParser $ \s -> - case reads (Text.unpack s) of - [(x, "")] -> return x - _ -> fail $ "invalid word (" ++ Text.unpack s ++ ")" - -instance FromJSONKey Addr where - fromJSONKey = FromJSONKeyTextParser $ \s -> - case reads (Text.unpack s) of - [(x, "")] -> return x - _ -> fail $ "invalid word (" ++ Text.unpack s ++ ")" - -#endif - -instance ParseField W256 -instance ParseFields W256 -instance ParseRecord W256 where - parseRecord = fmap getOnly parseRecord - -instance ParseField Addr -instance ParseFields Addr -instance ParseRecord Addr where - parseRecord = fmap getOnly parseRecord - -hexByteString :: String -> ByteString -> ByteString -hexByteString msg bs = - case BS16.decode bs of - Right x -> x - _ -> error ("invalid hex bytestring for " ++ msg) - -hexText :: Text -> ByteString -hexText t = - case BS16.decode (Text.encodeUtf8 (Text.drop 2 t)) of - Right x -> x - _ -> error ("invalid hex bytestring " ++ show t) - -readN :: Integral a => String -> a -readN s = fromIntegral (read s :: Integer) - -readNull :: Read a => a -> String -> a -readNull x = fromMaybe x . Text.Read.readMaybe - -wordField :: JSON.Object -> Text -> JSON.Parser W256 -wordField x f = ((readNull 0) . Text.unpack) - <$> (x .: f) - -addrField :: JSON.Object -> Text -> JSON.Parser Addr -addrField x f = (read . Text.unpack) <$> (x .: f) - -addrFieldMaybe :: JSON.Object -> Text -> JSON.Parser (Maybe Addr) -addrFieldMaybe x f = (Text.Read.readMaybe . Text.unpack) <$> (x .: f) - -dataField :: JSON.Object -> Text -> JSON.Parser ByteString -dataField x f = hexText <$> (x .: f) - -toWord512 :: W256 -> Word512 -toWord512 (W256 x) = fromHiAndLo 0 x - -fromWord512 :: Word512 -> W256 -fromWord512 x = W256 (loWord x) - -{-# SPECIALIZE num :: Word8 -> W256 #-} -num :: (Integral a, Num b) => a -> b -num = fromIntegral - -padLeft :: Int -> ByteString -> ByteString -padLeft n xs = BS.replicate (n - BS.length xs) 0 <> xs - -padRight :: Int -> ByteString -> ByteString -padRight n xs = xs <> BS.replicate (n - BS.length xs) 0 - -padRight' :: Int -> String -> String -padRight' n xs = xs <> replicate (n - length xs) '0' - --- | Right padding / truncating -truncpad :: Int -> [SWord 8] -> [SWord 8] -truncpad n xs = if m > n then take n xs - else mappend xs (replicate (n - m) 0) - where m = length xs - -padLeft' :: (Num a) => Int -> [a] -> [a] -padLeft' n xs = replicate (n - length xs) 0 <> xs - -word256 :: ByteString -> Word256 -word256 xs = case Cereal.runGet m (padLeft 32 xs) of - Left _ -> error "internal error" - Right x -> x - where - m = do a <- Cereal.getWord64be - b <- Cereal.getWord64be - c <- Cereal.getWord64be - d <- Cereal.getWord64be - return $ fromHiAndLo (fromHiAndLo a b) (fromHiAndLo c d) - -word :: ByteString -> W256 -word = W256 . word256 - -byteAt :: (Bits a, Bits b, Integral a, Num b) => a -> Int -> b -byteAt x j = num (x `shiftR` (j * 8)) .&. 0xff - -fromBE :: (Integral a) => ByteString -> a -fromBE xs = if xs == mempty then 0 - else 256 * fromBE (BS.init xs) - + (num $ BS.last xs) - -asBE :: (Integral a) => a -> ByteString -asBE 0 = mempty -asBE x = asBE (x `div` 256) - <> BS.pack [num $ x `mod` 256] - -word256Bytes :: W256 -> ByteString -word256Bytes x = BS.pack [byteAt x (31 - i) | i <- [0..31]] - -word160Bytes :: Addr -> ByteString -word160Bytes x = BS.pack [byteAt (addressWord160 x) (19 - i) | i <- [0..19]] - -newtype Nibble = Nibble Word8 - deriving ( Num, Integral, Real, Ord, Enum, Eq - , Bits, FiniteBits, Bounded, Generic) - -instance Show Nibble where - show = (:[]) . intToDigit . num - ---Get first and second Nibble from byte -hi, lo :: Word8 -> Nibble -hi b = Nibble $ b `shiftR` 4 -lo b = Nibble $ b .&. 0x0f - -toByte :: Nibble -> Nibble -> Word8 -toByte (Nibble high) (Nibble low) = high `shift` 4 .|. low - -unpackNibbles :: ByteString -> [Nibble] -unpackNibbles bs = BS.unpack bs >>= unpackByte - where unpackByte b = [hi b, lo b] - ---Well-defined for even length lists only (plz dependent types) -packNibbles :: [Nibble] -> ByteString -packNibbles [] = mempty -packNibbles (n1:n2:ns) = BS.singleton (toByte n1 n2) <> packNibbles ns -packNibbles _ = error "can't pack odd number of nibbles" - --- Keccak hashing - -keccakBytes :: ByteString -> ByteString -keccakBytes = - (hash :: ByteString -> Digest Keccak_256) - >>> BA.unpack - >>> BS.pack - -word32 :: [Word8] -> Word32 -word32 xs = sum [ fromIntegral x `shiftL` (8*n) - | (n, x) <- zip [0..] (reverse xs) ] - -keccak :: ByteString -> W256 -keccak = - keccakBytes - >>> BS.take 32 - >>> word - -abiKeccak :: ByteString -> Word32 -abiKeccak = - keccakBytes - >>> BS.take 4 - >>> BS.unpack - >>> word32 - --- Utils - -concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] -concatMapM f xs = liftM concat (mapM f xs) - -regexMatches :: Text -> Text -> Bool -regexMatches regexSource = - let - compOpts = - Regex.defaultCompOpt { Regex.lastStarGreedy = True } - execOpts = - Regex.defaultExecOpt { Regex.captureGroups = False } - regex = Regex.makeRegexOpts compOpts execOpts (Text.unpack regexSource) - in - Regex.matchTest regex . Seq.fromList . Text.unpack diff --git a/src/hevm/src/EVM/UnitTest.hs b/src/hevm/src/EVM/UnitTest.hs deleted file mode 100644 index 7a1cc6fc2..000000000 --- a/src/hevm/src/EVM/UnitTest.hs +++ /dev/null @@ -1,1006 +0,0 @@ -{-# Language LambdaCase #-} -{-# Language DataKinds #-} -{-# Language ImplicitParams #-} - -module EVM.UnitTest where - -import Prelude hiding (Word) - -import EVM -import EVM.ABI -import EVM.Concrete hiding (readMemoryWord) -import EVM.Symbolic -import EVM.Dapp -import EVM.Debug (srcMapCodePos) -import EVM.Exec -import EVM.Format -import EVM.Solidity -import EVM.SymExec -import EVM.Types -import EVM.Transaction (initTx) -import EVM.RLP -import qualified EVM.Fetch - -import qualified EVM.FeeSchedule as FeeSchedule - -import EVM.Stepper (Stepper, interpret) -import qualified EVM.Stepper as Stepper -import qualified Control.Monad.Operational as Operational - -import Control.Lens hiding (Indexed, elements, List) -import Control.Monad.State.Strict hiding (state) -import qualified Control.Monad.State.Strict as State - -import Control.Monad.Par.Class (spawn_) -import Control.Monad.Par.IO (runParIO) - -import qualified Data.ByteString.Lazy as BSLazy -import qualified Data.SBV.Trans.Control as SBV (Query, getValue, resetAssertions) -import qualified Data.SBV.Internals as SBV (State) -import Data.Binary.Get (runGet) -import Data.ByteString (ByteString) -import Data.SBV hiding (verbose) -import Data.SBV.Control (CheckSatResult(..), checkSat) -import Data.Decimal (DecimalRaw(..)) -import Data.Either (isRight, lefts) -import Data.Foldable (toList) -import Data.Map (Map) -import Data.Maybe (fromMaybe, catMaybes, fromJust, isJust, fromMaybe, mapMaybe, isNothing) -import Data.Text (isPrefixOf, stripSuffix, intercalate, Text, pack, unpack) -import Data.Text.Encoding (encodeUtf8) -import System.Environment (lookupEnv) -import System.IO (hFlush, stdout) - -import qualified Control.Monad.Par.Class as Par -import qualified Data.ByteString as BS -import qualified Data.Map as Map -import qualified Data.Sequence as Seq -import qualified Data.Text as Text -import qualified Data.Text.IO as Text - -import Data.MultiSet (MultiSet) -import qualified Data.MultiSet as MultiSet - -import Data.Set (Set) -import qualified Data.Set as Set - -import Data.Vector (Vector) -import qualified Data.Vector as Vector - -import Test.QuickCheck hiding (verbose) - -data UnitTestOptions = UnitTestOptions - { oracle :: EVM.Query -> IO (EVM ()) - , verbose :: Maybe Int - , maxIter :: Maybe Integer - , askSmtIters :: Maybe Integer - , maxDepth :: Maybe Int - , smtTimeout :: Maybe Integer - , smtState :: Maybe SBV.State - , solver :: Maybe Text - , covMatch :: Maybe Text - , match :: Text - , fuzzRuns :: Int - , replay :: Maybe (Text, BSLazy.ByteString) - , vmModifier :: VM -> VM - , dapp :: DappInfo - , testParams :: TestVMParams - , ffiAllowed :: Bool - } - -data TestVMParams = TestVMParams - { testAddress :: Addr - , testCaller :: Addr - , testOrigin :: Addr - , testGasCreate :: W256 - , testGasCall :: W256 - , testBaseFee :: W256 - , testPriorityFee :: W256 - , testBalanceCreate :: W256 - , testCoinbase :: Addr - , testNumber :: W256 - , testTimestamp :: W256 - , testGaslimit :: W256 - , testGasprice :: W256 - , testMaxCodeSize :: W256 - , testDifficulty :: W256 - , testChainId :: W256 - } - -defaultGasForCreating :: W256 -defaultGasForCreating = 0xffffffffffff - -defaultGasForInvoking :: W256 -defaultGasForInvoking = 0xffffffffffff - -defaultBalanceForTestContract :: W256 -defaultBalanceForTestContract = 0xffffffffffffffffffffffff - -defaultMaxCodeSize :: W256 -defaultMaxCodeSize = 0xffffffff - -type ABIMethod = Text - --- | Assuming a constructor is loaded, this stepper will run the constructor --- to create the test contract, give it an initial balance, and run `setUp()'. -initializeUnitTest :: UnitTestOptions -> SolcContract -> Stepper () -initializeUnitTest UnitTestOptions { .. } theContract = do - - let addr = testAddress testParams - - Stepper.evm $ do - -- Maybe modify the initial VM, e.g. to load library code - modify vmModifier - -- Make a trace entry for running the constructor - pushTrace (EntryTrace "constructor") - - -- Constructor is loaded; run until it returns code - void Stepper.execFully - - Stepper.evm $ do - -- Give a balance to the test target - env . contracts . ix addr . balance += w256 (testBalanceCreate testParams) - - -- call setUp(), if it exists, to initialize the test contract - let theAbi = view abiMap theContract - setUp = abiKeccak (encodeUtf8 "setUp()") - - when (isJust (Map.lookup setUp theAbi)) $ do - abiCall testParams (Left ("setUp()", emptyAbi)) - popTrace - pushTrace (EntryTrace "setUp()") - - -- Let `setUp()' run to completion - res <- Stepper.execFully - Stepper.evm $ case res of - Left e -> pushTrace (ErrorTrace e) - _ -> popTrace - - --- | Assuming a test contract is loaded and initialized, this stepper --- will run the specified test method and return whether it succeeded. -runUnitTest :: UnitTestOptions -> ABIMethod -> AbiValue -> Stepper Bool -runUnitTest a method args = do - x <- execTestStepper a method args - checkFailures a method x - -execTestStepper :: UnitTestOptions -> ABIMethod -> AbiValue -> Stepper Bool -execTestStepper UnitTestOptions { .. } methodName' method = do - -- Set up the call to the test method - Stepper.evm $ do - abiCall testParams (Left (methodName', method)) - pushTrace (EntryTrace methodName') - -- Try running the test method - Stepper.execFully >>= \case - -- If we failed, put the error in the trace. - Left e -> Stepper.evm (pushTrace (ErrorTrace e) >> popTrace) >> pure True - _ -> pure False - -exploreStep :: UnitTestOptions -> ByteString -> Stepper Bool -exploreStep UnitTestOptions{..} bs = do - Stepper.evm $ do - cs <- use (env . contracts) - abiCall testParams (Right bs) - let (Method _ inputs sig _ _) = fromMaybe (error "unknown abi call") $ Map.lookup (num $ word $ BS.take 4 bs) (view dappAbiMap dapp) - types = snd <$> inputs - let ?context = DappContext dapp cs - this <- fromMaybe (error "unknown target") <$> (use (env . contracts . at (testAddress testParams))) - let name = maybe "" (contractNamePart . view contractName) $ lookupCode (view contractcode this) dapp - pushTrace (EntryTrace (name <> "." <> sig <> "(" <> intercalate "," ((pack . show) <$> types) <> ")" <> showCall types (ConcreteBuffer bs))) - -- Try running the test method - Stepper.execFully >>= \case - -- If we failed, put the error in the trace. - Left e -> Stepper.evm (pushTrace (ErrorTrace e) >> popTrace) >> pure True - _ -> pure False - - -checkFailures :: UnitTestOptions -> ABIMethod -> Bool -> Stepper Bool -checkFailures UnitTestOptions { .. } method bailed = do - -- Decide whether the test is supposed to fail or succeed - let shouldFail = "testFail" `isPrefixOf` method - if bailed then - pure shouldFail - else do - -- Ask whether any assertions failed - Stepper.evm $ do - popTrace - abiCall testParams $ Left ("failed()", emptyAbi) - res <- Stepper.execFully - case res of - Right (ConcreteBuffer r) -> - let AbiBool failed = decodeAbiValue AbiBoolType (BSLazy.fromStrict r) - in pure (shouldFail == failed) - _ -> error "internal error: unexpected failure code" - --- | Randomly generates the calldata arguments and runs the test -fuzzTest :: UnitTestOptions -> Text -> [AbiType] -> VM -> Property -fuzzTest opts sig types vm = forAllShow (genAbiValue (AbiTupleType $ Vector.fromList types)) (show . ByteStringS . encodeAbiValue) - $ \args -> ioProperty $ - fst <$> runStateT (EVM.Stepper.interpret (oracle opts) (runUnitTest opts sig args)) vm - -tick :: Text -> IO () -tick x = Text.putStr x >> hFlush stdout - --- | This is like an unresolved source mapping. -data OpLocation = OpLocation - { srcContract :: Contract - , srcOpIx :: Int - } deriving (Show) - -instance Eq OpLocation where - (==) (OpLocation a b) (OpLocation a' b') = b == b' && view contractcode a == view contractcode a' - -instance Ord OpLocation where - compare (OpLocation a b) (OpLocation a' b') = compare (view contractcode a, b) (view contractcode a', b') - -srcMapForOpLocation :: DappInfo -> OpLocation -> Maybe SrcMap -srcMapForOpLocation dapp (OpLocation contr opIx) = srcMap dapp contr opIx - -type CoverageState = (VM, MultiSet OpLocation) - -currentOpLocation :: VM -> OpLocation -currentOpLocation vm = - case currentContract vm of - Nothing -> - error "internal error: why no contract?" - Just c -> - OpLocation - c - (fromMaybe (error "internal error: op ix") (vmOpIx vm)) - -execWithCoverage :: StateT CoverageState IO VMResult -execWithCoverage = do _ <- runWithCoverage - fromJust <$> use (_1 . result) - -runWithCoverage :: StateT CoverageState IO VM -runWithCoverage = do - -- This is just like `exec` except for every instruction evaluated, - -- we also increment a counter indexed by the current code location. - vm0 <- use _1 - case view result vm0 of - Nothing -> do - vm1 <- zoom _1 (State.state (runState exec1) >> get) - zoom _2 (modify (MultiSet.insert (currentOpLocation vm1))) - runWithCoverage - Just _ -> pure vm0 - - -interpretWithCoverage - :: UnitTestOptions - -> Stepper a - -> StateT CoverageState IO a -interpretWithCoverage opts = - eval . Operational.view - - where - eval - :: Operational.ProgramView Stepper.Action a - -> StateT CoverageState IO a - - eval (Operational.Return x) = - pure x - - eval (action Operational.:>>= k) = - case action of - Stepper.Exec -> - execWithCoverage >>= interpretWithCoverage opts . k - Stepper.Run -> - runWithCoverage >>= interpretWithCoverage opts . k - Stepper.Wait q -> - do m <- liftIO (oracle opts q) - zoom _1 (State.state (runState m)) >> interpretWithCoverage opts (k ()) - Stepper.Ask _ -> - error "cannot make choice in this interpreter" - Stepper.IOAct q -> - zoom _1 (StateT (runStateT q)) >>= interpretWithCoverage opts . k - Stepper.EVM m -> - zoom _1 (State.state (runState m)) >>= interpretWithCoverage opts . k - -coverageReport - :: DappInfo - -> MultiSet SrcMap - -> Map Text (Vector (Int, ByteString)) -coverageReport dapp cov = - let - sources :: SourceCache - sources = view dappSources dapp - - allPositions :: Set (Text, Int) - allPositions = - ( Set.fromList - . mapMaybe (srcMapCodePos sources) - . toList - $ mconcat - ( view dappSolcByName dapp - & Map.elems - & map (\x -> view runtimeSrcmap x <> view creationSrcmap x) - ) - ) - - srcMapCov :: MultiSet (Text, Int) - srcMapCov = MultiSet.mapMaybe (srcMapCodePos sources) cov - - linesByName :: Map Text (Vector ByteString) - linesByName = - Map.fromList $ zipWith - (\(name, _) lines' -> (name, lines')) - (view sourceFiles sources) - (view sourceLines sources) - - f :: Text -> Vector ByteString -> Vector (Int, ByteString) - f name = - Vector.imap - (\i bs -> - let - n = - if Set.member (name, i + 1) allPositions - then MultiSet.occur (name, i + 1) srcMapCov - else -1 - in (n, bs)) - in - Map.mapWithKey f linesByName - -coverageForUnitTestContract - :: UnitTestOptions - -> Map Text SolcContract - -> SourceCache - -> (Text, [(Test, [AbiType])]) - -> IO (MultiSet SrcMap) -coverageForUnitTestContract - opts@(UnitTestOptions {..}) contractMap _ (name, testNames) = do - - -- Look for the wanted contract by name from the Solidity info - case preview (ix name) contractMap of - Nothing -> - -- Fail if there's no such contract - error $ "Contract " ++ unpack name ++ " not found" - - Just theContract -> do - -- Construct the initial VM and begin the contract's constructor - let vm0 = initialUnitTestVm opts theContract - (vm1, cov1) <- - execStateT - (interpretWithCoverage opts - (Stepper.enter name >> initializeUnitTest opts theContract)) - (vm0, mempty) - - -- Define the thread spawner for test cases - let - runOne' (test, _) = spawn_ . liftIO $ do - (_, (_, cov)) <- - runStateT - (interpretWithCoverage opts (runUnitTest opts (extractSig test) emptyAbi)) - (vm1, mempty) - pure cov - -- Run all the test cases in parallel and gather their coverages - covs <- - runParIO (mapM runOne' testNames >>= mapM Par.get) - - -- Sum up all the coverage counts - let cov2 = MultiSet.unions (cov1 : covs) - - pure (MultiSet.mapMaybe (srcMapForOpLocation dapp) cov2) - -runUnitTestContract - :: UnitTestOptions - -> Map Text SolcContract - -> (Text, [(Test, [AbiType])]) - -> SBV.Query [(Bool, VM)] -runUnitTestContract - opts@(UnitTestOptions {..}) contractMap (name, testSigs) = do - - -- Print a header - liftIO $ putStrLn $ "Running " ++ show (length testSigs) ++ " tests for " - ++ unpack name - - -- Look for the wanted contract by name from the Solidity info - case preview (ix name) contractMap of - Nothing -> - -- Fail if there's no such contract - error $ "Contract " ++ unpack name ++ " not found" - - Just theContract -> do - -- Construct the initial VM and begin the contract's constructor - let vm0 = initialUnitTestVm opts theContract - vm1 <- - liftIO $ execStateT - (EVM.Stepper.interpret oracle - (Stepper.enter name >> initializeUnitTest opts theContract)) - vm0 - - case view result vm1 of - Nothing -> error "internal error: setUp() did not end with a result" - Just (VMFailure _) -> liftIO $ do - Text.putStrLn "\x1b[31m[BAIL]\x1b[0m setUp() " - tick "\n" - tick $ failOutput vm1 opts "setUp()" - pure [(False, vm1)] - Just (VMSuccess _) -> do - let - runCache :: ([(Either Text Text, VM)], VM) -> (Test, [AbiType]) - -> SBV.Query ([(Either Text Text, VM)], VM) - runCache (results, vm) (test, types) = do - (t, r, vm') <- runTest opts vm (test, types) - liftIO $ Text.putStrLn t - let vmCached = vm & set (cache . fetched) (view (cache . fetched) vm') - pure (((r, vm'): results), vmCached) - - -- Run all the test cases and print their status updates, - -- accumulating the vm cache throughout - (details, _) <- foldM runCache ([], vm1) testSigs - - let running = [x | (Right x, _) <- details] - let bailing = [x | (Left x, _) <- details] - - liftIO $ do - tick "\n" - tick (Text.unlines (filter (not . Text.null) running)) - tick (Text.unlines (filter (not . Text.null) bailing)) - - pure [(isRight r, vm) | (r, vm) <- details] - - -runTest :: UnitTestOptions -> VM -> (Test, [AbiType]) -> SBV.Query (Text, Either Text Text, VM) -runTest opts@UnitTestOptions{} vm (ConcreteTest testName, []) = liftIO $ runOne opts vm testName emptyAbi -runTest opts@UnitTestOptions{..} vm (ConcreteTest testName, types) = liftIO $ case replay of - Nothing -> - fuzzRun opts vm testName types - Just (sig, callData) -> - if sig == testName - then runOne opts vm testName $ - decodeAbiValue (AbiTupleType (Vector.fromList types)) callData - else fuzzRun opts vm testName types -runTest opts vm (SymbolicTest testName, types) = symRun opts vm testName types -runTest opts@UnitTestOptions{..} vm (InvariantTest testName, []) = liftIO $ case replay of - Nothing -> exploreRun opts vm testName [] - Just (sig, cds) -> - if sig == testName - then exploreRun opts vm testName (decodeCalls cds) - else exploreRun opts vm testName [] -runTest _ _ (InvariantTest _, types) = error $ "invariant testing with arguments: " <> show types <> " is not implemented (yet!)" - -type ExploreTx = (Addr, Addr, ByteString, W256) - -decodeCalls :: BSLazy.ByteString -> [ExploreTx] -decodeCalls b = fromMaybe (error "could not decode replay data") $ do - List v <- rlpdecode $ BSLazy.toStrict b - return $ flip fmap v $ \(List [BS caller', BS target, BS cd, BS ts]) -> (num (word caller'), num (word target), cd, word ts) - --- | Runs an invariant test, calls the invariant before execution begins -initialExplorationStepper :: UnitTestOptions -> ABIMethod -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP) -initialExplorationStepper opts'' testName replayData targets i = do - let history = List [] - x <- runUnitTest opts'' testName emptyAbi - if x - then explorationStepper opts'' testName replayData targets history i - else pure (False, history) - -explorationStepper :: UnitTestOptions -> ABIMethod -> [ExploreTx] -> [Addr] -> RLP -> Int -> Stepper (Bool, RLP) -explorationStepper _ _ _ _ history 0 = return (True, history) -explorationStepper opts@UnitTestOptions{..} testName replayData targets (List history) i = do - (caller', target, cd, timestamp') <- - case preview (ix (i - 1)) replayData of - Just v -> return v - Nothing -> - Stepper.evmIO $ do - vm <- get - let cs = view (env . contracts) vm - noCode c = case view contractcode c of - RuntimeCode c' -> len c' == 0 - _ -> False - mutable m = view methodMutability m `elem` [NonPayable, Payable] - knownAbis :: Map Addr SolcContract - knownAbis = - -- exclude contracts without code - Map.filter (not . BS.null . view runtimeCode) $ - -- exclude contracts without state changing functions - Map.filter (not . null . Map.filter mutable . view abiMap) $ - -- exclude testing abis - Map.filter (isNothing . preview (abiMap . ix unitTestMarkerAbi)) $ - -- pick all contracts with known compiler artifacts - fmap fromJust (Map.filter isJust $ Map.fromList [(addr, lookupCode (view contractcode c) dapp) | (addr, c) <- Map.toList cs]) - selected = [(addr, - fromMaybe (error ("no src found for: " <> show addr)) $ lookupCode (view contractcode (fromMaybe (error $ "contract not found: " <> show addr) $ Map.lookup addr cs)) dapp) - | addr <- targets] - -- go to IO and generate a random valid call to any known contract - liftIO $ do - -- select random contract - (target, solcInfo) <- generate $ elements (if null targets then Map.toList knownAbis else selected) - -- choose a random mutable method - (_, (Method _ inputs sig _ _)) <- generate (elements $ Map.toList $ Map.filter mutable $ view abiMap solcInfo) - let types = snd <$> inputs - -- set the caller to a random address with 90% probability, 10% known EOA address - let knownEOAs = Map.keys $ Map.filter noCode cs - AbiAddress caller' <- - if null knownEOAs - then generate $ genAbiValue AbiAddressType - else generate $ frequency - [ (90, genAbiValue AbiAddressType) - , (10, AbiAddress <$> elements knownEOAs) - ] - -- make a call with random valid data to the function - args <- generate $ genAbiValue (AbiTupleType $ Vector.fromList types) - let cd = abiMethod (sig <> "(" <> intercalate "," ((pack . show) <$> types) <> ")") args - -- increment timestamp with random amount - timepassed <- num <$> generate (arbitrarySizedNatural :: Gen Word32) - let ts = fromMaybe (error "symbolic timestamp not supported here") $ maybeLitWord $ view (block . timestamp) vm - return (caller', target, cd, num ts + timepassed) - let opts' = opts { testParams = testParams {testAddress = target, testCaller = caller', testTimestamp = timestamp'}} - thisCallRLP = List [BS $ word160Bytes caller', BS $ word160Bytes target, BS cd, BS $ word256Bytes timestamp'] - -- set the timestamp - Stepper.evm $ assign (block . timestamp) (w256lit timestamp') - -- perform the call - bailed <- exploreStep opts' cd - Stepper.evm popTrace - let newHistory = if bailed then List history else List (thisCallRLP:history) - opts'' = opts {testParams = testParams {testTimestamp = timestamp'}} - carryOn = explorationStepper opts'' testName replayData targets newHistory (i - 1) - -- if we didn't revert, run the test function - if bailed - then carryOn - else - do x <- runUnitTest opts'' testName emptyAbi - if x - then carryOn - else pure (False, List (thisCallRLP:history)) -explorationStepper _ _ _ _ _ _ = error "malformed rlp" - -getTargetContracts :: UnitTestOptions -> Stepper [Addr] -getTargetContracts UnitTestOptions{..} = do - vm <- Stepper.evm get - let Just contract' = currentContract vm - theAbi = view abiMap $ fromJust $ lookupCode (view contractcode contract') dapp - setUp = abiKeccak (encodeUtf8 "targetContracts()") - case Map.lookup setUp theAbi of - Nothing -> return [] - Just _ -> do - Stepper.evm $ abiCall testParams (Left ("targetContracts()", emptyAbi)) - res <- Stepper.execFully - case res of - Right (ConcreteBuffer r) -> - let AbiTuple vs = decodeAbiValue (AbiTupleType (Vector.fromList [AbiArrayDynamicType AbiAddressType])) (BSLazy.fromStrict r) - [AbiArrayDynamic AbiAddressType targets] = Vector.toList vs - in return $ fmap (\(AbiAddress a) -> a) (Vector.toList targets) - _ -> error "internal error: unexpected failure code" - -exploreRun :: UnitTestOptions -> VM -> ABIMethod -> [ExploreTx] -> IO (Text, Either Text Text, VM) -exploreRun opts@UnitTestOptions{..} initialVm testName replayTxs = do - (targets, _) <- runStateT (EVM.Stepper.interpret oracle (getTargetContracts opts)) initialVm - let depth = fromMaybe 20 maxDepth - ((x, counterex), vm') <- - if null replayTxs - then - foldM (\a@((success, _), _) _ -> - if success - then runStateT (EVM.Stepper.interpret oracle (initialExplorationStepper opts testName [] targets depth)) initialVm - else pure a) - ((True, (List [])), initialVm) -- no canonical "post vm" - [0..fuzzRuns] - else runStateT (EVM.Stepper.interpret oracle (initialExplorationStepper opts testName replayTxs targets (length replayTxs))) initialVm - if x - then return ("\x1b[32m[PASS]\x1b[0m " <> testName <> " (runs: " <> (pack $ show fuzzRuns) <>", depth: " <> pack (show depth) <> ")", - Right (passOutput vm' opts testName), vm') -- no canonical "post vm" - else let replayText = if null replayTxs - then "\nReplay data: '(" <> pack (show testName) <> "," <> pack (show (show (ByteStringS $ rlpencode counterex))) <> ")'" - else " (replayed)" - in return ("\x1b[31m[FAIL]\x1b[0m " <> testName <> replayText, Left (failOutput vm' opts testName), vm') - -execTest :: UnitTestOptions -> VM -> ABIMethod -> AbiValue -> IO (Bool, VM) -execTest opts@UnitTestOptions{..} vm testName args = - runStateT - (EVM.Stepper.interpret oracle (execTestStepper opts testName args)) - vm - --- | Define the thread spawner for normal test cases -runOne :: UnitTestOptions -> VM -> ABIMethod -> AbiValue -> IO (Text, Either Text Text, VM) -runOne opts@UnitTestOptions{..} vm testName args = do - let argInfo = pack (if args == emptyAbi then "" else " with arguments: " <> show args) - (bailed, vm') <- execTest opts vm testName args - (success, vm'') <- - runStateT - (EVM.Stepper.interpret oracle (checkFailures opts testName bailed)) vm' - if success - then - let gasSpent = num (testGasCall testParams) - view (state . gas) vm' - gasText = pack $ show (fromIntegral gasSpent :: Integer) - in - pure - ("\x1b[32m[PASS]\x1b[0m " - <> testName <> argInfo <> " (gas: " <> gasText <> ")" - , Right (passOutput vm'' opts testName) - , vm'' - ) - else if bailed then - pure - ("\x1b[31m[BAIL]\x1b[0m " - <> testName <> argInfo - , Left (failOutput vm'' opts testName) - , vm'' - ) - else - pure - ("\x1b[31m[FAIL]\x1b[0m " - <> testName <> argInfo - , Left (failOutput vm'' opts testName) - , vm'' - ) - --- | Define the thread spawner for property based tests -fuzzRun :: UnitTestOptions -> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM) -fuzzRun opts@UnitTestOptions{..} vm testName types = do - let args = Args{ replay = Nothing - , maxSuccess = fuzzRuns - , maxDiscardRatio = 10 - , maxSize = 100 - , chatty = isJust verbose - , maxShrinks = maxBound - } - quickCheckWithResult args (fuzzTest opts testName types vm) >>= \case - Success numTests _ _ _ _ _ -> - pure ("\x1b[32m[PASS]\x1b[0m " - <> testName <> " (runs: " <> (pack $ show numTests) <> ")" - -- this isn't the post vm we actually want, as we - -- can't retrieve the correct vm from quickcheck - , Right (passOutput vm opts testName) - , vm - ) - Failure _ _ _ _ _ _ _ _ _ _ failCase _ _ -> - let abiValue = decodeAbiValue (AbiTupleType (Vector.fromList types)) $ BSLazy.fromStrict $ hexText (pack $ concat failCase) - ppOutput = pack $ show abiValue - in do - -- Run the failing test again to get a proper trace - vm' <- execStateT (EVM.Stepper.interpret oracle (runUnitTest opts testName abiValue)) vm - pure ("\x1b[31m[FAIL]\x1b[0m " - <> testName <> ". Counterexample: " <> ppOutput - <> "\nRun:\n dapp test --replay '(\"" <> testName <> "\",\"" - <> (pack (concat failCase)) <> "\")'\nto test this case again, or \n dapp debug --replay '(\"" - <> testName <> "\",\"" <> (pack (concat failCase)) <> "\")'\nto debug it." - , Left (failOutput vm' opts testName) - , vm' - ) - _ -> pure ("\x1b[31m[OOPS]\x1b[0m " - <> testName - , Left (failOutput vm opts testName) - , vm - ) - --- | Define the thread spawner for symbolic tests --- TODO: return a list of VM's -symRun :: UnitTestOptions -> VM -> Text -> [AbiType] -> SBV.Query (Text, Either Text Text, VM) -symRun opts@UnitTestOptions{..} concreteVm testName types = do - SBV.resetAssertions - let vm = symbolify concreteVm - (cd, cdlen) <- symCalldata testName types [] - let cd' = (SymbolicBuffer cd, w256lit cdlen) - shouldFail = "proveFail" `isPrefixOf` testName - - -- get all posible postVMs for the test method - allPaths <- fst <$> runStateT - (EVM.SymExec.interpret oracle maxIter askSmtIters (execSymTest opts testName cd')) vm - let consistentPaths = flip filter allPaths $ - \(_, vm') -> case view result vm' of - Just (VMFailure DeadPath) -> False - _ -> True - results <- forM consistentPaths $ - -- If the vm execution succeeded, check if the vm is reachable, - -- and if any ds-test assertions were triggered - -- Report a failure depending on the prefix of the test name - - -- If the vm execution failed, check if the vm is reachable, and if so, - -- report a failure unless the test is supposed to fail. - - \(bailed, vm') -> do - let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts } - SBV.resetAssertions - constrain $ sAnd (fst <$> view EVM.constraints vm') - unless bailed $ - let - checkResult buf = constrain $ litBytes (encodeAbiValue $ AbiBool $ not shouldFail) .== buf - in case view result vm' of - Just (VMSuccess (SymbolicBuffer buf)) -> checkResult buf - Just (VMSuccess (ConcreteBuffer buf)) -> checkResult (litBytes buf) - r -> error $ "unexpected return value: " ++ show r - checkSat >>= \case - Sat -> do - prettyCd <- prettyCalldata cd' testName types - let explorationFailed = case view result vm' of - Just (VMFailure e) -> case e of - NotUnique _ -> True - UnexpectedSymbolicArg -> True - _ -> False - _ -> False - return $ - if shouldFail && bailed && not explorationFailed - then Right () - else Left (vm', prettyCd) - Unsat -> return $ Right () - Unk -> return $ Left (vm', "SMT Query Timeout! Try setting a higher timeout with the --smttimeout flag or the DAPP_TEST_SMTTIMEOUT environment variable.") - DSat _ -> error "Unexpected DSat" - - if null $ lefts results - then - return ("\x1b[32m[PASS]\x1b[0m " <> testName, Right "", vm) - else - return ("\x1b[31m[FAIL]\x1b[0m " <> testName, Left $ symFailure opts testName (lefts results), vm) - -symFailure :: UnitTestOptions -> Text -> [(VM, Text)] -> Text -symFailure UnitTestOptions {..} testName failures' = mconcat - [ "Failure: " - , testName - , "\n\n" - , intercalate "\n" $ indentLines 2 . mkMsg <$> failures' - ] - where - showRes vm = let Just res = view result vm in - case res of - VMFailure _ -> - let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts} - in prettyvmresult res - VMSuccess _ -> if "proveFail" `isPrefixOf` testName - then "Successful execution" - else "Failed: DSTest Assertion Violation" - mkMsg (vm, cd) = pack $ unlines - ["Counterexample:" - ,"" - ," result: " <> showRes vm - ," calldata: " <> unpack cd - , case verbose of - Just _ -> unlines - [ "" - , unpack $ indentLines 2 (showTraceTree dapp vm) - ] - _ -> "" - ] - -prettyCalldata :: (?context :: DappContext) => (Buffer, SymWord) -> Text -> [AbiType]-> SBV.Query Text -prettyCalldata (buffer, S _ cdlen) sig types = do - cdlen' <- num <$> SBV.getValue cdlen - cd <- case buffer of - SymbolicBuffer cd -> mapM (SBV.getValue . fromSized) (take cdlen' cd) <&> BS.pack - ConcreteBuffer cd -> return $ BS.take cdlen' cd - pure $ (head (Text.splitOn "(" sig)) <> showCall types (ConcreteBuffer cd) - -execSymTest :: UnitTestOptions -> ABIMethod -> (Buffer, SymWord) -> Stepper (Bool, VM) -execSymTest opts@UnitTestOptions{ .. } method cd = do - -- Set up the call to the test method - Stepper.evm $ do - makeTxCall testParams cd - pushTrace (EntryTrace method) - -- Try running the test method - Stepper.runFully >>= \vm' -> case view result vm' of - Just (VMFailure err) -> - -- If we failed, put the error in the trace. - Stepper.evm (pushTrace (ErrorTrace err)) >> pure (True, vm') - Just (VMSuccess _) -> do - postVm <- checkSymFailures opts - -- calls to failed() contain reverting branches since https://github.com/dapphub/ds-test/pull/30 - case view result postVm of - Just (VMSuccess _) -> pure (False, postVm) - Just (VMFailure _) -> pure (True, postVm) - r -> error $ "unexpected return value after call to failed(): " ++ show r - Nothing -> error "Internal Error: execSymTest: vm has not completed execution!" - -checkSymFailures :: UnitTestOptions -> Stepper VM -checkSymFailures UnitTestOptions { .. } = do - -- Ask whether any assertions failed - Stepper.evm $ do - popTrace - abiCall testParams (Left ("failed()", emptyAbi)) - Stepper.runFully - -indentLines :: Int -> Text -> Text -indentLines n s = - let p = Text.replicate n " " - in Text.unlines (map (p <>) (Text.lines s)) - -passOutput :: VM -> UnitTestOptions -> Text -> Text -passOutput vm UnitTestOptions { .. } testName = - let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts } - in let v = fromMaybe 0 verbose - in if (v > 1) then - mconcat - [ "Success: " - , fromMaybe "" (stripSuffix "()" testName) - , "\n" - , if (v > 2) then indentLines 2 (showTraceTree dapp vm) else "" - , indentLines 2 (formatTestLogs (view dappEventMap dapp) (view logs vm)) - , "\n" - ] - else "" - -failOutput :: VM -> UnitTestOptions -> Text -> Text -failOutput vm UnitTestOptions { .. } testName = - let ?context = DappContext { _contextInfo = dapp, _contextEnv = vm ^?! EVM.env . EVM.contracts} - in mconcat - [ "Failure: " - , fromMaybe "" (stripSuffix "()" testName) - , "\n" - , case verbose of - Just _ -> indentLines 2 (showTraceTree dapp vm) - _ -> "" - , indentLines 2 (formatTestLogs (view dappEventMap dapp) (view logs vm)) - , "\n" - ] - -formatTestLogs :: (?context :: DappContext) => Map W256 Event -> Seq.Seq Log -> Text -formatTestLogs events xs = - case catMaybes (toList (fmap (formatTestLog events) xs)) of - [] -> "\n" - ys -> "\n" <> intercalate "\n" ys <> "\n\n" - --- Here we catch and render some special logs emitted by ds-test, --- with the intent to then present them in a separate view to the --- regular trace output. -formatTestLog :: (?context :: DappContext) => Map W256 Event -> Log -> Maybe Text -formatTestLog _ (Log _ _ []) = Nothing -formatTestLog events (Log _ args (topic:_)) = - case maybeLitWord topic >>= \t1 -> (Map.lookup (wordValue t1) events) of - Nothing -> Nothing - Just (Event name _ types) -> - case (name <> parenthesise (abiTypeSolidity <$> (unindexed types))) of - "log(string)" -> Just $ unquote $ showValue AbiStringType args - - -- log_named_x(string, x) - "log_named_bytes32(string, bytes32)" -> log_named - "log_named_address(string, address)" -> log_named - "log_named_int(string, int256)" -> log_named - "log_named_uint(string, uint256)" -> log_named - "log_named_bytes(string, bytes)" -> log_named - "log_named_string(string, string)" -> log_named - - -- log_named_decimal_x(string, uint, x) - "log_named_decimal_int(string, int256, uint256)" -> log_named_decimal - "log_named_decimal_uint(string, uint256, uint256)" -> log_named_decimal - - -- log_x(x) - "log_bytes32(bytes32)" -> log_unnamed - "log_address(address)" -> log_unnamed - "log_int(int256)" -> log_unnamed - "log_uint(uint256)" -> log_unnamed - "log_bytes(bytes)" -> log_unnamed - "log_string(string)" -> log_unnamed - - -- log_named_x(bytes32, x), as used in older versions of ds-test. - -- bytes32 are opportunistically represented as strings in Format.hs - "log_named_bytes32(bytes32, bytes32)" -> log_named - "log_named_address(bytes32, address)" -> log_named - "log_named_int(bytes32, int256)" -> log_named - "log_named_uint(bytes32, uint256)" -> log_named - - _ -> Nothing - - where - ts = unindexed types - unquote = Text.dropAround (\c -> c == '"' || c == '«' || c == '»') - log_unnamed = - Just $ showValue (head ts) args - log_named = - let [key, val] = take 2 (textValues ts args) - in Just $ unquote key <> ": " <> val - showDecimal dec val = - pack $ show $ Decimal (num dec) val - log_named_decimal = - case args of - (ConcreteBuffer b) -> - case toList $ runGet (getAbiSeq (length ts) ts) (BSLazy.fromStrict b) of - [key, (AbiUInt 256 val), (AbiUInt 256 dec)] -> - Just $ (unquote (showAbiValue key)) <> ": " <> showDecimal dec val - [key, (AbiInt 256 val), (AbiUInt 256 dec)] -> - Just $ (unquote (showAbiValue key)) <> ": " <> showDecimal dec val - _ -> Nothing - (SymbolicBuffer _) -> Just "" - - -word32Bytes :: Word32 -> ByteString -word32Bytes x = BS.pack [byteAt x (3 - i) | i <- [0..3]] - -abiCall :: TestVMParams -> Either (Text, AbiValue) ByteString -> EVM () -abiCall params args = - let cd = case args of - Left (sig, args') -> abiMethod sig args' - Right b -> b - l = num . BS.length $ cd - in makeTxCall params (ConcreteBuffer cd, litWord l) - -makeTxCall :: TestVMParams -> (Buffer, SymWord) -> EVM () -makeTxCall TestVMParams{..} cd = do - resetState - assign (tx . isCreate) False - loadContract testAddress - assign (state . calldata) cd - assign (state . caller) (litAddr testCaller) - assign (state . gas) (w256 testGasCall) - origin' <- fromMaybe (initialContract (RuntimeCode mempty)) <$> use (env . contracts . at testOrigin) - let originBal = view balance origin' - when (originBal < (w256 testGasprice) * (w256 testGasCall)) $ error "insufficient balance for gas cost" - vm <- get - put $ initTx vm - -initialUnitTestVm :: UnitTestOptions -> SolcContract -> VM -initialUnitTestVm (UnitTestOptions {..}) theContract = - let - TestVMParams {..} = testParams - vm = makeVm $ VMOpts - { vmoptContract = initialContract (InitCode (ConcreteBuffer (view creationCode theContract))) - , vmoptCalldata = (mempty, 0) - , vmoptValue = 0 - , vmoptAddress = testAddress - , vmoptCaller = litAddr testCaller - , vmoptOrigin = testOrigin - , vmoptGas = testGasCreate - , vmoptGaslimit = testGasCreate - , vmoptCoinbase = testCoinbase - , vmoptNumber = testNumber - , vmoptTimestamp = litWord $ w256 testTimestamp - , vmoptBlockGaslimit = testGaslimit - , vmoptGasprice = testGasprice - , vmoptBaseFee = testBaseFee - , vmoptPriorityFee = testPriorityFee - , vmoptMaxCodeSize = testMaxCodeSize - , vmoptDifficulty = testDifficulty - , vmoptSchedule = FeeSchedule.berlin - , vmoptChainId = testChainId - , vmoptCreate = True - , vmoptStorageModel = ConcreteS -- TODO: support RPC - , vmoptTxAccessList = mempty -- TODO: support unit test access lists??? - , vmoptAllowFFI = ffiAllowed - } - creator = - initialContract (RuntimeCode mempty) - & set nonce 1 - & set balance (w256 testBalanceCreate) - in vm - & set (env . contracts . at ethrunAddress) (Just creator) - - --- | takes a concrete VM and makes all storage symbolic -symbolify :: VM -> VM -symbolify vm = - vm & over (env . contracts . each . storage) mkSymStorage - & set (env . storageModel) InitialS - where - mkSymStorage :: Storage -> Storage - mkSymStorage (Symbolic _ _) = error "should not happen" - mkSymStorage (Concrete s) = - let - list = [(literal $ toSizzle k, v) | (C _ k, S _ v) <- Map.toList s] - symlist = [(litWord k, v) | (k, v) <- Map.toList s] - in Symbolic symlist $ sListArray 0 list - -getParametersFromEnvironmentVariables :: Maybe Text -> IO TestVMParams -getParametersFromEnvironmentVariables rpc = do - block' <- maybe EVM.Fetch.Latest (EVM.Fetch.BlockNumber . read) <$> (lookupEnv "DAPP_TEST_NUMBER") - - (miner,ts,blockNum,diff,limit,base) <- - case rpc of - Nothing -> return (0,0,0,0,0,0) - Just url -> EVM.Fetch.fetchBlockFrom block' url >>= \case - Nothing -> error "Could not fetch block" - Just EVM.Block{..} -> return ( _coinbase - , wordValue $ forceLit _timestamp - , wordValue _number - , wordValue _difficulty - , wordValue _gaslimit - , wordValue _baseFee - ) - let - getWord s def = maybe def read <$> lookupEnv s - getAddr s def = maybe def read <$> lookupEnv s - - TestVMParams - <$> getAddr "DAPP_TEST_ADDRESS" (createAddress ethrunAddress 1) - <*> getAddr "DAPP_TEST_CALLER" ethrunAddress - <*> getAddr "DAPP_TEST_ORIGIN" ethrunAddress - <*> getWord "DAPP_TEST_GAS_CREATE" defaultGasForCreating - <*> getWord "DAPP_TEST_GAS_CALL" defaultGasForInvoking - <*> getWord "DAPP_TEST_BASEFEE" base - <*> getWord "DAPP_TEST_PRIORITYFEE" 0 - <*> getWord "DAPP_TEST_BALANCE" defaultBalanceForTestContract - <*> getAddr "DAPP_TEST_COINBASE" miner - <*> getWord "DAPP_TEST_NUMBER" blockNum - <*> getWord "DAPP_TEST_TIMESTAMP" ts - <*> getWord "DAPP_TEST_GAS_LIMIT" limit - <*> getWord "DAPP_TEST_GAS_PRICE" 0 - <*> getWord "DAPP_TEST_MAXCODESIZE" defaultMaxCodeSize - <*> getWord "DAPP_TEST_DIFFICULTY" diff - <*> getWord "DAPP_TEST_CHAINID" 99 diff --git a/src/hevm/src/EVM/VMTest.hs b/src/hevm/src/EVM/VMTest.hs deleted file mode 100644 index 3e6ed12a2..000000000 --- a/src/hevm/src/EVM/VMTest.hs +++ /dev/null @@ -1,367 +0,0 @@ -{-# Language CPP #-} -{-# Language TemplateHaskell #-} - -module EVM.VMTest - ( Case - , BlockchainCase -#if MIN_VERSION_aeson(1, 0, 0) - , parseBCSuite -#endif - , initTx - , setupTx - , vmForCase - , checkExpectation - ) where - -import Prelude hiding (Word) - -import qualified EVM -import EVM (contractcode, storage, origStorage, balance, nonce, Storage(..), initialContract) -import qualified EVM.Concrete as EVM -import qualified EVM.FeeSchedule - -import EVM.Symbolic -import EVM.Transaction -import EVM.Types - -import Control.Arrow ((***), (&&&)) -import Control.Lens -import Control.Monad - -import GHC.Stack - -import Data.Aeson ((.:), (.:?), FromJSON (..)) -import Data.Foldable (fold) -import Data.Map (Map) -import Data.Maybe (fromMaybe, isNothing) -import Data.Witherable (Filterable, catMaybes) - -import qualified Data.Map as Map -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Types as JSON -import qualified Data.ByteString.Lazy as Lazy -import qualified Data.ByteString as BS - -data Which = Pre | Post - -data Block = Block - { blockCoinbase :: Addr - , blockDifficulty :: W256 - , blockGasLimit :: W256 - , blockBaseFee :: W256 - , blockNumber :: W256 - , blockTimestamp :: W256 - , blockTxs :: [Transaction] - } deriving Show - -data Case = Case - { testVmOpts :: EVM.VMOpts - , checkContracts :: Map Addr EVM.Contract - , testExpectation :: Map Addr EVM.Contract - } deriving Show - -data BlockchainCase = BlockchainCase - { blockchainBlocks :: [Block] - , blockchainPre :: Map Addr EVM.Contract - , blockchainPost :: Map Addr EVM.Contract - , blockchainNetwork :: String - } deriving Show - -splitEithers :: (Filterable f) => f (Either a b) -> (f a, f b) -splitEithers = - (catMaybes *** catMaybes) - . (fmap fst &&& fmap snd) - . (fmap (preview _Left &&& preview _Right)) - -checkStateFail :: Bool -> Case -> EVM.VM -> (Bool, Bool, Bool, Bool, Bool) -> IO Bool -checkStateFail diff x vm (okState, okMoney, okNonce, okData, okCode) = do - let - printContracts :: Map Addr EVM.Contract -> IO () - printContracts cs = putStrLn $ Map.foldrWithKey (\k v acc -> - acc ++ show k ++ " : " - ++ (show . toInteger $ (view nonce v)) ++ " " - ++ (show . toInteger $ (view balance v)) ++ " " - ++ (printStorage $ (view storage v)) - ++ "\n") "" cs - - reason = map fst (filter (not . snd) - [ ("bad-state", okMoney || okNonce || okData || okCode || okState) - , ("bad-balance", not okMoney || okNonce || okData || okCode || okState) - , ("bad-nonce", not okNonce || okMoney || okData || okCode || okState) - , ("bad-storage", not okData || okMoney || okNonce || okCode || okState) - , ("bad-code", not okCode || okMoney || okNonce || okData || okState) - ]) - check = checkContracts x - expected = testExpectation x - actual = view (EVM.env . EVM.contracts . to (fmap (clearZeroStorage.clearOrigStorage))) vm - printStorage (EVM.Symbolic _ c) = show c - printStorage (EVM.Concrete c) = show $ Map.toList c - - putStr (unwords reason) - when (diff && (not okState)) $ do - putStrLn "\nPre balance/state: " - printContracts check - putStrLn "\nExpected balance/state: " - printContracts expected - putStrLn "\nActual balance/state: " - printContracts actual - return okState - -checkExpectation :: HasCallStack => Bool -> Case -> EVM.VM -> IO Bool -checkExpectation diff x vm = do - let expectation = testExpectation x - (okState, b2, b3, b4, b5) = checkExpectedContracts vm $ expectation - unless okState $ void $ checkStateFail - diff x vm (okState, b2, b3, b4, b5) - return okState - --- quotient account state by nullness -(~=) :: Map Addr EVM.Contract -> Map Addr EVM.Contract -> Bool -(~=) cs cs' = - let nullAccount = EVM.initialContract (EVM.RuntimeCode mempty) - padNewAccounts cs'' ks = (fold [Map.insertWith (\_ x -> x) k nullAccount | k <- ks]) cs'' - padded_cs' = padNewAccounts cs' (Map.keys cs) - padded_cs = padNewAccounts cs (Map.keys cs') - in and $ zipWith (===) (Map.elems padded_cs) (Map.elems padded_cs') - -(===) :: EVM.Contract -> EVM.Contract -> Bool -a === b = codeEqual && storageEqual && (view balance a == view balance b) && (view nonce a == view nonce b) - where - storageEqual = view storage a == view storage b - codeEqual = case (view contractcode a, view contractcode b) of - (EVM.RuntimeCode (ConcreteBuffer a'), EVM.RuntimeCode (ConcreteBuffer b')) -> a' == b' - _ -> error "unexpected code" - -checkExpectedContracts :: HasCallStack => EVM.VM -> Map Addr EVM.Contract -> (Bool, Bool, Bool, Bool, Bool) -checkExpectedContracts vm expected = - let cs = vm ^. EVM.env . EVM.contracts . to (fmap (clearZeroStorage.clearOrigStorage)) - expectedCs = clearOrigStorage <$> expected - in ( (expectedCs ~= cs) - , (clearBalance <$> expectedCs) ~= (clearBalance <$> cs) - , (clearNonce <$> expectedCs) ~= (clearNonce <$> cs) - , (clearStorage <$> expectedCs) ~= (clearStorage <$> cs) - , (clearCode <$> expectedCs) ~= (clearCode <$> cs) - ) - -clearOrigStorage :: EVM.Contract -> EVM.Contract -clearOrigStorage = set origStorage mempty - -clearZeroStorage :: EVM.Contract -> EVM.Contract -clearZeroStorage c = case view storage c of - EVM.Symbolic _ _ -> c - EVM.Concrete m -> let store = Map.filter (\x -> forceLit x /= 0) m - in set EVM.storage (EVM.Concrete store) c - -clearStorage :: EVM.Contract -> EVM.Contract -clearStorage = set storage (EVM.Concrete mempty) - -clearBalance :: EVM.Contract -> EVM.Contract -clearBalance = set balance 0 - -clearNonce :: EVM.Contract -> EVM.Contract -clearNonce = set nonce 0 - -clearCode :: EVM.Contract -> EVM.Contract -clearCode = set contractcode (EVM.RuntimeCode mempty) - -#if MIN_VERSION_aeson(1, 0, 0) - -instance FromJSON EVM.Contract where - parseJSON (JSON.Object v) = do - code <- (EVM.RuntimeCode . ConcreteBuffer <$> (hexText <$> v .: "code")) - storage' <- Map.mapKeys w256 <$> v .: "storage" - balance' <- v .: "balance" - nonce' <- v .: "nonce" - return - $ - EVM.initialContract code - & balance .~ w256 balance' - & nonce .~ w256 nonce' - & storage .~ EVM.Concrete (fmap (litWord . w256) storage') - & origStorage .~ fmap w256 storage' - - parseJSON invalid = - JSON.typeMismatch "Contract" invalid - -instance FromJSON BlockchainCase where - parseJSON (JSON.Object v) = BlockchainCase - <$> v .: "blocks" - <*> parseContracts Pre v - <*> parseContracts Post v - <*> v .: "network" - parseJSON invalid = - JSON.typeMismatch "GeneralState test case" invalid - -instance FromJSON Block where - parseJSON (JSON.Object v) = do - v' <- v .: "blockHeader" - txs <- v .: "transactions" - coinbase <- addrField v' "coinbase" - difficulty <- wordField v' "difficulty" - gasLimit <- wordField v' "gasLimit" - number <- wordField v' "number" - baseFee <- fmap read <$> v' .:? "baseFeePerGas" - timestamp <- wordField v' "timestamp" - return $ Block coinbase difficulty gasLimit (fromMaybe 0 baseFee) number timestamp txs - parseJSON invalid = - JSON.typeMismatch "Block" invalid - -parseContracts :: - Which -> JSON.Object -> JSON.Parser (Map Addr EVM.Contract) -parseContracts w v = - v .: which >>= parseJSON - where which = case w of - Pre -> "pre" - Post -> "postState" - -parseBCSuite :: - Lazy.ByteString -> Either String (Map String Case) -parseBCSuite x = case (JSON.eitherDecode' x) :: Either String (Map String BlockchainCase) of - Left e -> Left e - Right bcCases -> let allCases = fromBlockchainCase <$> bcCases - keepError (Left e) = errorFatal e - keepError _ = True - filteredCases = Map.filter keepError allCases - (erroredCases, parsedCases) = splitEithers filteredCases - in if Map.size erroredCases > 0 - then Left ("errored case: " ++ (show erroredCases)) - else if Map.size parsedCases == 0 - then Left "No cases to check." - else Right parsedCases -#endif - -data BlockchainError - = TooManyBlocks - | TooManyTxs - | NoTxs - | SignatureUnverified - | InvalidTx - | OldNetwork - | FailedCreate - deriving Show - -errorFatal :: BlockchainError -> Bool -errorFatal TooManyBlocks = True -errorFatal TooManyTxs = True -errorFatal SignatureUnverified = True -errorFatal InvalidTx = True -errorFatal _ = False - -fromBlockchainCase :: BlockchainCase -> Either BlockchainError Case -fromBlockchainCase (BlockchainCase blocks preState postState network) = - case (blocks, network) of - ([block], "London") -> case blockTxs block of - [tx] -> fromBlockchainCase' block tx preState postState - [] -> Left NoTxs - _ -> Left TooManyTxs - ([_], _) -> Left OldNetwork - (_, _) -> Left TooManyBlocks - -fromBlockchainCase' :: Block -> Transaction - -> Map Addr EVM.Contract -> Map Addr EVM.Contract - -> Either BlockchainError Case -fromBlockchainCase' block tx preState postState = - let isCreate = isNothing (txToAddr tx) in - case (sender 1 tx, checkTx tx block preState) of - (Nothing, _) -> Left SignatureUnverified - (_, Nothing) -> Left (if isCreate then FailedCreate else InvalidTx) - (Just origin, Just checkState) -> Right $ Case - (EVM.VMOpts - { vmoptContract = EVM.initialContract theCode - , vmoptCalldata = cd - , vmoptValue = litWord (w256 $ txValue tx) - , vmoptAddress = toAddr - , vmoptCaller = litAddr origin - , vmoptOrigin = origin - , vmoptGas = txGasLimit tx - fromIntegral (txGasCost feeSchedule tx) - , vmoptBaseFee = blockBaseFee block - , vmoptPriorityFee = priorityFee tx (blockBaseFee block) - , vmoptGaslimit = txGasLimit tx - , vmoptNumber = blockNumber block - , vmoptTimestamp = litWord $ w256 $ blockTimestamp block - , vmoptCoinbase = blockCoinbase block - , vmoptDifficulty = blockDifficulty block - , vmoptMaxCodeSize = 24576 - , vmoptBlockGaslimit = blockGasLimit block - , vmoptGasprice = effectiveGasPrice - , vmoptSchedule = feeSchedule - , vmoptChainId = 1 - , vmoptCreate = isCreate - , vmoptStorageModel = EVM.ConcreteS - , vmoptTxAccessList = txAccessMap tx - , vmoptAllowFFI = False - }) - checkState - postState - where - toAddr = fromMaybe (EVM.createAddress origin senderNonce) (txToAddr tx) - senderNonce = EVM.wordValue $ view (accountAt origin . nonce) preState - feeSchedule = EVM.FeeSchedule.berlin - toCode = Map.lookup toAddr preState - theCode = if isCreate - then EVM.InitCode (ConcreteBuffer (txData tx)) - else maybe (EVM.RuntimeCode mempty) (view contractcode) toCode - effectiveGasPrice = effectiveprice tx (blockBaseFee block) - cd = if isCreate - then (mempty, 0) - else let l = num . BS.length $ txData tx - in (ConcreteBuffer $ txData tx, litWord l) - -effectiveprice :: Transaction -> W256 -> W256 -effectiveprice tx baseFee = priorityFee tx baseFee + baseFee - -priorityFee :: Transaction -> W256 -> W256 -priorityFee tx baseFee = let - (txPrioMax, txMaxFee) = case txType tx of - EIP1559Transaction -> - let Just maxPrio = txMaxPriorityFeeGas tx - Just maxFee = txMaxFeePerGas tx - in (maxPrio, maxFee) - _ -> - let Just gasPrice = txGasPrice tx - in (gasPrice, gasPrice) - in min txPrioMax (txMaxFee - baseFee) - -maxBaseFee :: Transaction -> W256 -maxBaseFee tx = - case txType tx of - EIP1559Transaction -> - let Just maxFee = txMaxFeePerGas tx - in maxFee - _ -> - let Just gasPrice = txGasPrice tx - in gasPrice - - -validateTx :: Transaction -> Block -> Map Addr EVM.Contract -> Maybe () -validateTx tx block cs = do - origin <- sender 1 tx - originBalance <- (view balance) <$> view (at origin) cs - originNonce <- (view nonce) <$> view (at origin) cs - let gasDeposit = w256 $ (effectiveprice tx (blockBaseFee block)) * (txGasLimit tx) - if gasDeposit + (w256 $ txValue tx) <= originBalance - && (w256 $ txNonce tx) == originNonce && blockBaseFee block <= maxBaseFee tx - then Just () - else Nothing - -checkTx :: Transaction -> Block -> Map Addr EVM.Contract -> Maybe (Map Addr EVM.Contract) -checkTx tx block prestate = do - origin <- sender 1 tx - validateTx tx block prestate - let isCreate = isNothing (txToAddr tx) - senderNonce = EVM.wordValue $ view (accountAt origin . nonce) prestate - toAddr = fromMaybe (EVM.createAddress origin senderNonce) (txToAddr tx) - prevCode = view (accountAt toAddr . contractcode) prestate - prevNonce = view (accountAt toAddr . nonce) prestate - if isCreate && ((case prevCode of {EVM.RuntimeCode b -> len b /= 0; _ -> True}) || (prevNonce /= 0)) - then mzero - else - return $ prestate - -vmForCase :: Case -> EVM.VM -vmForCase x = - let - vm = EVM.makeVm (testVmOpts x) - & set (EVM.env . EVM.contracts) (checkContracts x) - in - initTx vm diff --git a/src/hevm/stack.yaml b/src/hevm/stack.yaml deleted file mode 100644 index e2eadd55a..000000000 --- a/src/hevm/stack.yaml +++ /dev/null @@ -1,22 +0,0 @@ -resolver: lts-17.14 -packages: -- . -extra-deps: -- HSH-2.1.3 -- monoidal-containers-0.6.0.1 -- restless-git-0.7 -- s-cargot-0.1.4.0 -- tree-view-0.5 -- text-format-0.3.2 -- witherable-0.3.5 -- base16-bytestring-1.0.1.0@sha256:33b9d57afa334d06485033e930c6b13fc760baf88fd8f715ae2f9a4b46e19a54,2641 -- github: dmjio/semver-range - commit: d8d9db892ddb6ae267c9bcbc4f6602668433f12a -- github: leventerkok/sbv # 8.9 - commit: b64905e2698c320ac14ffbad53325d33081839fb -flags: {} -extra-package-dbs: [] -image: - container: - name: mbrock/hevm - base: haskell:8.0.1 diff --git a/src/hevm/test/test.hs b/src/hevm/test/test.hs deleted file mode 100644 index 61bc74396..000000000 --- a/src/hevm/test/test.hs +++ /dev/null @@ -1,796 +0,0 @@ -{-# Language OverloadedStrings #-} -{-# Language ViewPatterns #-} -{-# Language ScopedTypeVariables #-} -{-# Language LambdaCase #-} -{-# Language QuasiQuotes #-} -{-# Language FlexibleInstances #-} -{-# Language GeneralizedNewtypeDeriving #-} -{-# Language DataKinds #-} -{-# Language StandaloneDeriving #-} - -module Main where - -import Data.Text (Text) -import Data.ByteString (ByteString) - -import Prelude hiding (fail) - -import qualified Data.Text as Text -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BS (fromStrict) -import qualified Data.ByteString.Base16 as Hex -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.Tasty.Runners - -import Control.Monad.State.Strict (execState, runState) -import Control.Lens hiding (List, pre, (.>)) - -import qualified Data.Vector as Vector -import Data.String.Here - -import Control.Monad.Fail - -import Data.Binary.Put (runPut) -import Data.SBV hiding ((===), forAll, sList) -import Data.SBV.Control -import qualified Data.Map as Map -import Data.Binary.Get (runGetOrFail) - -import EVM hiding (Query) -import EVM.SymExec -import EVM.ABI -import EVM.Exec -import qualified EVM.Patricia as Patricia -import EVM.Precompiled -import EVM.RLP -import EVM.Solidity -import EVM.Types - -instance MonadFail Query where - fail = io . fail - -main :: IO () -main = defaultMain tests - --- | run a subset of tests in the repl. p is a tasty pattern: --- https://github.com/UnkindPartition/tasty/tree/ee6fe7136fbcc6312da51d7f1b396e1a2d16b98a#patterns -runSubSet :: String -> IO () -runSubSet p = defaultMain . applyPattern p $ tests - -tests :: TestTree -tests = testGroup "hevm" - [ testGroup "ABI" - [ testProperty "Put/get inverse" $ \x -> - case runGetOrFail (getAbi (abiValueType x)) (runPut (putAbi x)) of - Right ("", _, x') -> x' == x - _ -> False - ] - , testGroup "Solidity expressions" - [ testCase "Trivial" $ - SolidityCall "x = 3;" [] - ===> AbiUInt 256 3 - - , testCase "Arithmetic" $ do - SolidityCall "x = a + 1;" - [AbiUInt 256 1] ===> AbiUInt 256 2 - SolidityCall "unchecked { x = a - 1; }" - [AbiUInt 8 0] ===> AbiUInt 8 255 - - , testCase "keccak256()" $ - SolidityCall "x = uint(keccak256(abi.encodePacked(a)));" - [AbiString ""] ===> AbiUInt 256 0xc5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470 - - , testProperty "abi encoding vs. solidity" $ withMaxSuccess 20 $ forAll (arbitrary >>= genAbiValue) $ - \y -> ioProperty $ do - -- traceM ("encoding: " ++ (show y) ++ " : " ++ show (abiValueType y)) - Just encoded <- runStatements [i| x = abi.encode(a);|] - [y] AbiBytesDynamicType - let AbiTuple (Vector.toList -> [solidityEncoded]) = decodeAbiValue (AbiTupleType $ Vector.fromList [AbiBytesDynamicType]) (BS.fromStrict encoded) - let hevmEncoded = encodeAbiValue (AbiTuple $ Vector.fromList [y]) - -- traceM ("encoded (solidity): " ++ show solidityEncoded) - -- traceM ("encoded (hevm): " ++ show (AbiBytesDynamic hevmEncoded)) - assertEqual "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmEncoded) - - , testProperty "abi encoding vs. solidity (2 args)" $ withMaxSuccess 20 $ forAll (arbitrary >>= bothM genAbiValue) $ - \(x', y') -> ioProperty $ do - -- traceM ("encoding: " ++ (show x') ++ ", " ++ (show y') ++ " : " ++ show (abiValueType x') ++ ", " ++ show (abiValueType y')) - Just encoded <- runStatements [i| x = abi.encode(a, b);|] - [x', y'] AbiBytesDynamicType - let AbiTuple (Vector.toList -> [solidityEncoded]) = decodeAbiValue (AbiTupleType $ Vector.fromList [AbiBytesDynamicType]) (BS.fromStrict encoded) - let hevmEncoded = encodeAbiValue (AbiTuple $ Vector.fromList [x',y']) - -- traceM ("encoded (solidity): " ++ show solidityEncoded) - -- traceM ("encoded (hevm): " ++ show (AbiBytesDynamic hevmEncoded)) - assertEqual "abi encoding mismatch" solidityEncoded (AbiBytesDynamic hevmEncoded) - ] - - , testGroup "Precompiled contracts" - [ testGroup "Example (reverse)" - [ testCase "success" $ - assertEqual "example contract reverses" - (execute 0xdeadbeef "foobar" 6) (Just "raboof") - , testCase "failure" $ - assertEqual "example contract fails on length mismatch" - (execute 0xdeadbeef "foobar" 5) Nothing - ] - - , testGroup "ECRECOVER" - [ testCase "success" $ do - let - r = hex "c84e55cee2032ea541a32bf6749e10c8b9344c92061724c4e751600f886f4732" - s = hex "1542b6457e91098682138856165381453b3d0acae2470286fd8c8a09914b1b5d" - v = hex "000000000000000000000000000000000000000000000000000000000000001c" - h = hex "513954cf30af6638cb8f626bd3f8c39183c26784ce826084d9d267868a18fb31" - a = hex "0000000000000000000000002d5e56d45c63150d937f2182538a0f18510cb11f" - assertEqual "successful recovery" - (Just a) - (execute 1 (h <> v <> r <> s) 32) - , testCase "fail on made up values" $ do - let - r = hex "c84e55cee2032ea541a32bf6749e10c8b9344c92061724c4e751600f886f4731" - s = hex "1542b6457e91098682138856165381453b3d0acae2470286fd8c8a09914b1b5d" - v = hex "000000000000000000000000000000000000000000000000000000000000001c" - h = hex "513954cf30af6638cb8f626bd3f8c39183c26784ce826084d9d267868a18fb31" - assertEqual "fail because bit flip" - Nothing - (execute 1 (h <> v <> r <> s) 32) - ] - ] - , testGroup "Byte/word manipulations" - [ testProperty "padLeft length" $ \n (Bytes bs) -> - BS.length (padLeft n bs) == max n (BS.length bs) - , testProperty "padLeft identity" $ \(Bytes bs) -> - padLeft (BS.length bs) bs == bs - , testProperty "padRight length" $ \n (Bytes bs) -> - BS.length (padLeft n bs) == max n (BS.length bs) - , testProperty "padRight identity" $ \(Bytes bs) -> - padLeft (BS.length bs) bs == bs - , testProperty "padLeft zeroing" $ \(NonNegative n) (Bytes bs) -> - let x = BS.take n (padLeft (BS.length bs + n) bs) - y = BS.replicate n 0 - in x == y - ] - - , testGroup "Unresolved link detection" - [ testCase "holes detected" $ do - let code' = "608060405234801561001057600080fd5b5060405161040f38038061040f83398181016040528101906100329190610172565b73__$f3cbc3eb14e5bd0705af404abcf6f741ec$__63ab5c1ffe826040518263ffffffff1660e01b81526004016100699190610217565b60206040518083038186803b15801561008157600080fd5b505af4158015610095573d6000803e3d6000fd5b505050506040513d601f19601f820116820180604052508101906100b99190610145565b50506103c2565b60006100d36100ce84610271565b61024c565b9050828152602081018484840111156100ef576100ee610362565b5b6100fa8482856102ca565b509392505050565b600081519050610111816103ab565b92915050565b600082601f83011261012c5761012b61035d565b5b815161013c8482602086016100c0565b91505092915050565b60006020828403121561015b5761015a61036c565b5b600061016984828501610102565b91505092915050565b6000602082840312156101885761018761036c565b5b600082015167ffffffffffffffff8111156101a6576101a5610367565b5b6101b284828501610117565b91505092915050565b60006101c6826102a2565b6101d081856102ad565b93506101e08185602086016102ca565b6101e981610371565b840191505092915050565b60006102016003836102ad565b915061020c82610382565b602082019050919050565b6000604082019050818103600083015261023181846101bb565b90508181036020830152610244816101f4565b905092915050565b6000610256610267565b905061026282826102fd565b919050565b6000604051905090565b600067ffffffffffffffff82111561028c5761028b61032e565b5b61029582610371565b9050602081019050919050565b600081519050919050565b600082825260208201905092915050565b60008115159050919050565b60005b838110156102e85780820151818401526020810190506102cd565b838111156102f7576000848401525b50505050565b61030682610371565b810181811067ffffffffffffffff821117156103255761032461032e565b5b80604052505050565b7f4e487b7100000000000000000000000000000000000000000000000000000000600052604160045260246000fd5b600080fd5b600080fd5b600080fd5b600080fd5b6000601f19601f8301169050919050565b7f6261720000000000000000000000000000000000000000000000000000000000600082015250565b6103b4816102be565b81146103bf57600080fd5b50565b603f806103d06000396000f3fe6080604052600080fdfea26469706673582212207d03b26e43dc3d116b0021ddc9817bde3762a3b14315351f11fc4be384fd14a664736f6c63430008060033" - assertBool "linker hole not detected" (containsLinkerHole code'), - testCase "no false positives" $ do - let code' = "0x608060405234801561001057600080fd5b50600436106100365760003560e01c806317bf8bac1461003b578063acffee6b1461005d575b600080fd5b610043610067565b604051808215151515815260200191505060405180910390f35b610065610073565b005b60008060015414905090565b6000809054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1663f8a8fd6d6040518163ffffffff1660e01b815260040160206040518083038186803b1580156100da57600080fd5b505afa1580156100ee573d6000803e3d6000fd5b505050506040513d602081101561010457600080fd5b810190808051906020019092919050505060018190555056fea265627a7a723158205d775f914dcb471365a430b5f5b2cfe819e615cbbb5b2f1ccc7da1fd802e43c364736f6c634300050b0032" - assertBool "false positive" (not . containsLinkerHole $ code') - ] - - , testGroup "metadata stripper" - [ testCase "it strips the metadata for solc => 0.6" $ do - let code' = hexText "0x608060405234801561001057600080fd5b50600436106100365760003560e01c806317bf8bac1461003b578063acffee6b1461005d575b600080fd5b610043610067565b604051808215151515815260200191505060405180910390f35b610065610073565b005b60008060015414905090565b6000809054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1663f8a8fd6d6040518163ffffffff1660e01b815260040160206040518083038186803b1580156100da57600080fd5b505afa1580156100ee573d6000803e3d6000fd5b505050506040513d602081101561010457600080fd5b810190808051906020019092919050505060018190555056fea265627a7a723158205d775f914dcb471365a430b5f5b2cfe819e615cbbb5b2f1ccc7da1fd802e43c364736f6c634300050b0032" - stripped = stripBytecodeMetadata code' - assertEqual "failed to strip metadata" (show (ByteStringS stripped)) "0x608060405234801561001057600080fd5b50600436106100365760003560e01c806317bf8bac1461003b578063acffee6b1461005d575b600080fd5b610043610067565b604051808215151515815260200191505060405180910390f35b610065610073565b005b60008060015414905090565b6000809054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1663f8a8fd6d6040518163ffffffff1660e01b815260040160206040518083038186803b1580156100da57600080fd5b505afa1580156100ee573d6000803e3d6000fd5b505050506040513d602081101561010457600080fd5b810190808051906020019092919050505060018190555056fe" - , - testCase "it strips the metadata and constructor args" $ do - let srccode = - [i| - contract A { - uint y; - constructor(uint x) public { - y = x; - } - } - |] - - (json, path') <- solidity' srccode - let Just (solc', _, _) = readJSON json - initCode :: ByteString - Just initCode = solc' ^? ix (path' <> ":A") . creationCode - -- add constructor arguments - assertEqual "constructor args screwed up metadata stripping" (stripBytecodeMetadata (initCode <> encodeAbiValue (AbiUInt 256 1))) (stripBytecodeMetadata initCode) - ] - - , testGroup "RLP encodings" - [ testProperty "rlp decode is a retraction (bytes)" $ \(Bytes bs) -> --- withMaxSuccess 100000 $ - rlpdecode (rlpencode (BS bs)) == Just (BS bs) - , testProperty "rlp encode is a partial inverse (bytes)" $ \(Bytes bs) -> --- withMaxSuccess 100000 $ - case rlpdecode bs of - Just r -> rlpencode r == bs - Nothing -> True - , testProperty "rlp decode is a retraction (RLP)" $ \(RLPData r) -> --- withMaxSuccess 100000 $ - rlpdecode (rlpencode r) == Just r - ] - , testGroup "Merkle Patricia Trie" - [ testProperty "update followed by delete is id" $ \(Bytes r, Bytes s, Bytes t) -> - whenFail - (putStrLn ("r:" <> (show (ByteStringS r))) >> - putStrLn ("s:" <> (show (ByteStringS s))) >> - putStrLn ("t:" <> (show (ByteStringS t)))) $ --- withMaxSuccess 100000 $ - Patricia.insertValues [(r, BS.pack[1]), (s, BS.pack[2]), (t, BS.pack[3]), - (r, mempty), (s, mempty), (t, mempty)] - === (Just $ Patricia.Literal Patricia.Empty) - ] - - , testGroup "Symbolic execution" - [ - -- Somewhat tautological since we are asserting the precondition - -- on the same form as the actual "requires" clause. - testCase "SafeAdd success case" $ do - Just safeAdd <- solcRuntime "SafeAdd" - [i| - contract SafeAdd { - function add(uint x, uint y) public pure returns (uint z) { - require((z = x + y) >= x); - } - } - |] - let pre preVM = let [x, y] = getStaticAbiArgs preVM - in x .<= x + y - .&& view (state . callvalue) preVM .== 0 - post = Just $ \(prestate, poststate) -> - let [x, y] = getStaticAbiArgs prestate - in case view result poststate of - Just (VMSuccess (SymbolicBuffer out)) -> (fromBytes out) .== x + y - _ -> sFalse - (Qed res, _) <- runSMT $ query $ verifyContract safeAdd (Just ("add(uint256,uint256)", [AbiUIntType 256, AbiUIntType 256])) [] SymbolicS pre post - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - - testCase "x == y => x + y == 2 * y" $ do - Just safeAdd <- solcRuntime "SafeAdd" - [i| - contract SafeAdd { - function add(uint x, uint y) public pure returns (uint z) { - require((z = x + y) >= x); - } - } - |] - let pre preVM = let [x, y] = getStaticAbiArgs preVM - in (x .<= x + y) - .&& (x .== y) - .&& view (state . callvalue) preVM .== 0 - post (prestate, poststate) = - let [_, y] = getStaticAbiArgs prestate - in case view result poststate of - Just (VMSuccess (SymbolicBuffer out)) -> fromBytes out .== 2 * y - _ -> sFalse - (Qed res, _) <- runSMTWith z3 $ query $ - verifyContract safeAdd (Just ("add(uint256,uint256)", [AbiUIntType 256, AbiUIntType 256])) [] SymbolicS pre (Just post) - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - testCase "summary storage writes" $ do - Just c <- solcRuntime "A" - [i| - contract A { - uint x; - function f(uint256 y) public { - unchecked { - x += y; - x += y; - } - } - } - |] - let pre vm = 0 .== view (state . callvalue) vm - post = Just $ \(prestate, poststate) -> - let [y] = getStaticAbiArgs prestate - this = view (state . codeContract) prestate - Just preC = view (env.contracts . at this) prestate - Just postC = view (env.contracts . at this) poststate - Symbolic _ prestore = _storage preC - Symbolic _ poststore = _storage postC - prex = readArray prestore 0 - postx = readArray poststore 0 - in case view result poststate of - Just (VMSuccess _) -> prex + 2 * y .== postx - _ -> sFalse - (Qed res, _) <- runSMT $ query $ verifyContract c (Just ("f(uint256)", [AbiUIntType 256])) [] SymbolicS pre post - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - -- tests how whiffValue handles Neg via application of the triple IsZero simplification rule - -- regression test for: https://github.com/dapphub/dapptools/pull/698 - testCase "Neg" $ do - let src = - [i| - object "Neg" { - code { - // Deploy the contract - datacopy(0, dataoffset("runtime"), datasize("runtime")) - return(0, datasize("runtime")) - } - object "runtime" { - code { - let v := calldataload(4) - if iszero(iszero(and(v, not(0xffffffffffffffffffffffffffffffffffffffff)))) { - invalid() - } - } - } - } - |] - Just c <- yulRuntime "Neg" src - (Qed res, _) <- runSMTWith cvc4 $ query $ checkAssert defaultPanicCodes c (Just ("hello(address)", [AbiAddressType])) [] - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - - -- Inspired by these `msg.sender == to` token bugs - -- which break linearity of totalSupply. - testCase "catch storage collisions" $ do - Just c <- solcRuntime "A" - [i| - contract A { - function f(uint x, uint y) public { - assembly { - let newx := sub(sload(x), 1) - let newy := add(sload(y), 1) - sstore(x,newx) - sstore(y,newy) - } - } - } - |] - let pre vm = 0 .== view (state . callvalue) vm - post (prestate, poststate) = - let [x,y] = getStaticAbiArgs prestate - this = view (state . codeContract) prestate - (Just preC, Just postC) = both' (view (env.contracts . at this)) (prestate, poststate) - --Just postC = view (env.contracts . at this) poststate - (Symbolic _ prestore, Symbolic _ poststore) = both' (view storage) (preC, postC) - (prex, prey) = both' (readArray prestore) (x, y) - (postx, posty) = both' (readArray poststore) (x, y) - in case view result poststate of - Just (VMSuccess _) -> prex + prey .== postx + (posty :: SWord 256) - _ -> sFalse - bs <- runSMT $ query $ do - (Cex _, vm) <- verifyContract c (Just ("f(uint256,uint256)", [AbiUIntType 256, AbiUIntType 256])) [] SymbolicS pre (Just post) - case view (state . calldata . _1) vm of - SymbolicBuffer bs -> BS.pack <$> mapM (getValue.fromSized) bs - ConcreteBuffer _ -> error "unexpected" - - let [AbiUInt 256 x, AbiUInt 256 y] = decodeAbiValues [AbiUIntType 256, AbiUIntType 256] bs - assertEqual "Catch storage collisions" x y - , - testCase "Deposit contract loop (z3)" $ do - Just c <- solcRuntime "Deposit" - [i| - contract Deposit { - function deposit(uint256 deposit_count) external pure { - require(deposit_count < 2**32 - 1); - ++deposit_count; - bool found = false; - for (uint height = 0; height < 32; height++) { - if ((deposit_count & 1) == 1) { - found = true; - break; - } - deposit_count = deposit_count >> 1; - } - assert(found); - } - } - |] - (Qed res, _) <- runSMTWith z3 $ query $ checkAssert defaultPanicCodes c (Just ("deposit(uint256)", [AbiUIntType 256])) [] - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - testCase "Deposit contract loop (cvc4)" $ do - Just c <- solcRuntime "Deposit" - [i| - contract Deposit { - function deposit(uint256 deposit_count) external pure { - require(deposit_count < 2**32 - 1); - ++deposit_count; - bool found = false; - for (uint height = 0; height < 32; height++) { - if ((deposit_count & 1) == 1) { - found = true; - break; - } - deposit_count = deposit_count >> 1; - } - assert(found); - } - } - |] - (Qed res, _) <- runSMTWith cvc4 $ query $ checkAssert defaultPanicCodes c (Just ("deposit(uint256)", [AbiUIntType 256])) [] - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - testCase "Deposit contract loop (error version)" $ do - Just c <- solcRuntime "Deposit" - [i| - contract Deposit { - function deposit(uint8 deposit_count) external pure { - require(deposit_count < 2**32 - 1); - ++deposit_count; - bool found = false; - for (uint height = 0; height < 32; height++) { - if ((deposit_count & 1) == 1) { - found = true; - break; - } - deposit_count = deposit_count >> 1; - } - assert(found); - } - } - |] - bs <- runSMT $ query $ do - (Cex _, vm) <- checkAssert allPanicCodes c (Just ("deposit(uint8)", [AbiUIntType 8])) [] - case view (state . calldata . _1) vm of - SymbolicBuffer bs -> BS.pack <$> mapM (getValue.fromSized) bs - ConcreteBuffer _ -> error "unexpected" - - let [deposit] = decodeAbiValues [AbiUIntType 8] bs - assertEqual "overflowing uint8" deposit (AbiUInt 8 255) - , - testCase "explore function dispatch" $ do - Just c <- solcRuntime "A" - [i| - contract A { - function f(uint x) public pure returns (uint) { - return x; - } - } - |] - (Qed res, _) <- runSMTWith z3 $ do - setTimeOut 5000 - query $ checkAssert defaultPanicCodes c Nothing [] - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - - testCase "injectivity of keccak (32 bytes)" $ do - Just c <- solcRuntime "A" - [i| - contract A { - function f(uint x, uint y) public pure { - if (keccak256(abi.encodePacked(x)) == keccak256(abi.encodePacked(y))) assert(x == y); - } - } - |] - (Qed res, _) <- runSMTWith cvc4 $ query $ checkAssert defaultPanicCodes c (Just ("f(uint256,uint256)", [AbiUIntType 256, AbiUIntType 256])) [] - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - testCase "injectivity of keccak (32 bytes)" $ do - Just c <- solcRuntime "A" - [i| - contract A { - function f(uint x, uint y) public pure { - if (keccak256(abi.encodePacked(x)) == keccak256(abi.encodePacked(y))) assert(x == y); - } - } - |] - (Qed res, _) <- runSMTWith z3 $ query $ checkAssert defaultPanicCodes c (Just ("f(uint256,uint256)", [AbiUIntType 256, AbiUIntType 256])) [] - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - , - - testCase "injectivity of keccak (64 bytes)" $ do - Just c <- solcRuntime "A" - [i| - contract A { - function f(uint x, uint y, uint w, uint z) public pure { - assert (keccak256(abi.encodePacked(x,y)) != keccak256(abi.encodePacked(w,z))); - } - } - |] - bs <- runSMTWith z3 $ query $ do - (Cex _, vm) <- checkAssert defaultPanicCodes c (Just ("f(uint256,uint256,uint256,uint256)", replicate 4 (AbiUIntType 256))) [] - case view (state . calldata . _1) vm of - SymbolicBuffer bs -> BS.pack <$> mapM (getValue.fromSized) bs - ConcreteBuffer _ -> error "unexpected" - - let [AbiUInt 256 x, - AbiUInt 256 y, - AbiUInt 256 w, - AbiUInt 256 z] = decodeAbiValues [AbiUIntType 256, - AbiUIntType 256, - AbiUIntType 256, - AbiUIntType 256] bs - assertEqual "x == w" x w - assertEqual "y == z" y z - , - - testCase "calldata beyond calldatasize is 0 (z3)" $ do - Just c <- solcRuntime "A" - [i| - contract A { - function f() public pure { - uint y; - assembly { - let x := calldatasize() - y := calldataload(x) - } - assert(y == 0); - } - } - |] - Qed res <- runSMTWith z3 $ do - setTimeOut 5000 - query $ fst <$> checkAssert defaultPanicCodes c Nothing [] - putStrLn $ "successfully explored: " <> show (length res) <> " paths" - - , - - testCase "keccak soundness" $ do - Just c <- solcRuntime "C" - [i| - contract C { - mapping (uint => mapping (uint => uint)) maps; - - function f(uint x, uint y) public view { - assert(maps[y][0] == maps[x][0]); - } - } - |] - -- should find a counterexample - Cex _ <- runSMTWith cvc4 $ query $ fst <$> checkAssert defaultPanicCodes c (Just ("f(uint256,uint256)", [AbiUIntType 256, AbiUIntType 256])) [] - putStrLn "found counterexample:" - - - , - testCase "multiple contracts" $ do - let code' = - [i| - contract C { - uint x; - A constant a = A(0x35D1b3F3D7966A1DFe207aa4514C12a259A0492B); - - function call_A() public view { - // should fail since a.x() can be anything - assert(a.x() == x); - } - } - contract A { - uint public x; - } - |] - aAddr = Addr 0x35D1b3F3D7966A1DFe207aa4514C12a259A0492B - Just c <- solcRuntime "C" code' - Just a <- solcRuntime "A" code' - Cex _ <- runSMT $ query $ do - vm0 <- abstractVM (Just ("call_A()", [])) [] c SymbolicS - store <- freshArray (show aAddr) Nothing - let vm = vm0 - & set (state . callvalue) 0 - & over (env . contracts) - (Map.insert aAddr (initialContract (RuntimeCode $ ConcreteBuffer a) & - set EVM.storage (EVM.Symbolic [] store))) - verify vm Nothing Nothing Nothing (Just $ checkAssertions defaultPanicCodes) - putStrLn "found counterexample:" - , - testCase "calling unique contracts (read from storage)" $ do - let code' = - [i| - contract C { - uint x; - A a; - - function call_A() public { - a = new A(); - // should fail since x can be anything - assert(a.x() == x); - } - } - contract A { - uint public x; - } - |] - Just c <- solcRuntime "C" code' - Cex _ <- runSMT $ query $ do - vm0 <- abstractVM (Just ("call_A()", [])) [] c SymbolicS - let vm = vm0 & set (state . callvalue) 0 - verify vm Nothing Nothing Nothing (Just $ checkAssertions defaultPanicCodes) - putStrLn "found counterexample:" - , - - testCase "keccak concrete and sym agree" $ do - let code' = - [i| - contract C { - function kecc(uint x) public pure { - if (x == 0) { - assert(keccak256(abi.encode(x)) == keccak256(abi.encode(0))); - } - } - } - |] - Just c <- solcRuntime "C" code' - Qed _ <- runSMT $ query $ do - vm0 <- abstractVM (Just ("kecc(uint256)", [AbiUIntType 256])) [] c SymbolicS - let vm = vm0 & set (state . callvalue) 0 - verify vm Nothing Nothing Nothing (Just $ checkAssertions defaultPanicCodes) - putStrLn "found counterexample:" - - , testCase "safemath distributivity (yul)" $ do - Qed _ <- runSMTWith cvc4 $ query $ do - let yulsafeDistributivity = hex "6355a79a6260003560e01c14156016576015601f565b5b60006000fd60a1565b603d602d604435600435607c565b6039602435600435607c565b605d565b6052604b604435602435605d565b600435607c565b141515605a57fe5b5b565b6000828201821115151560705760006000fd5b82820190505b92915050565b6000818384048302146000841417151560955760006000fd5b82820290505b92915050565b" - vm <- abstractVM (Just ("distributivity(uint256,uint256,uint256)", [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] yulsafeDistributivity SymbolicS - verify vm Nothing Nothing Nothing (Just $ checkAssertions defaultPanicCodes) - putStrLn "Proven" - - , testCase "safemath distributivity (sol)" $ do - let code' = - [i| - contract C { - function distributivity(uint x, uint y, uint z) public { - assert(mul(x, add(y, z)) == add(mul(x, y), mul(x, z))); - } - - function add(uint x, uint y) internal pure returns (uint z) { - unchecked { - require((z = x + y) >= x, "ds-math-add-overflow"); - } - } - function mul(uint x, uint y) internal pure returns (uint z) { - unchecked { - require(y == 0 || (z = x * y) / y == x, "ds-math-mul-overflow"); - } - } - } - |] - Just c <- solcRuntime "C" code' - - Qed _ <- runSMTWith cvc4 $ query $ do - vm <- abstractVM (Just ("distributivity(uint256,uint256,uint256)", [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] c SymbolicS - verify vm Nothing Nothing Nothing (Just $ checkAssertions defaultPanicCodes) - putStrLn "Proven" - - ] - , testGroup "Equivalence checking" - [ - testCase "yul optimized" $ do - -- These yul programs are not equivalent: (try --calldata $(seth --to-uint256 2) for example) - Just aPrgm <- yul "" - [i| - { - calldatacopy(0, 0, 32) - switch mload(0) - case 0 { } - case 1 { } - default { invalid() } - } - |] - Just bPrgm <- yul "" - [i| - { - calldatacopy(0, 0, 32) - switch mload(0) - case 0 { } - case 2 { } - default { invalid() } - } - |] - runSMTWith z3 $ query $ do - Cex _ <- equivalenceCheck aPrgm bPrgm Nothing Nothing Nothing - return () - ] - ] - where - (===>) = assertSolidityComputation - - -runSimpleVM :: ByteString -> ByteString -> Maybe ByteString -runSimpleVM x ins = case loadVM x of - Nothing -> Nothing - Just vm -> let calldata' = (ConcreteBuffer ins, w256lit $ num $ BS.length ins) - in case runState (assign (state.calldata) calldata' >> exec) vm of - (VMSuccess (ConcreteBuffer bs), _) -> Just bs - _ -> Nothing - -loadVM :: ByteString -> Maybe VM -loadVM x = - case runState exec (vmForEthrunCreation x) of - (VMSuccess (ConcreteBuffer targetCode), vm1) -> do - let target = view (state . contract) vm1 - vm2 = execState (replaceCodeOfSelf (RuntimeCode (ConcreteBuffer targetCode))) vm1 - return $ snd $ flip runState vm2 - (do resetState - assign (state . gas) 0xffffffffffffffff -- kludge - loadContract target) - _ -> Nothing - -hex :: ByteString -> ByteString -hex s = - case Hex.decode s of - Right x -> x - Left e -> error e - -singleContract :: Text -> Text -> IO (Maybe ByteString) -singleContract x s = - solidity x [i| - pragma experimental ABIEncoderV2; - contract ${x} { ${s} } - |] - -defaultDataLocation :: AbiType -> Text -defaultDataLocation t = - if (case t of - AbiBytesDynamicType -> True - AbiStringType -> True - AbiArrayDynamicType _ -> True - AbiArrayType _ _ -> True - _ -> False) - then "memory" - else "" - -runFunction :: Text -> ByteString -> IO (Maybe ByteString) -runFunction c input = do - Just x <- singleContract "X" c - return $ runSimpleVM x input - -runStatements - :: Text -> [AbiValue] -> AbiType - -> IO (Maybe ByteString) -runStatements stmts args t = do - let params = - Text.intercalate ", " - (map (\(x, c) -> abiTypeSolidity (abiValueType x) - <> " " <> defaultDataLocation (abiValueType x) - <> " " <> Text.pack [c]) - (zip args "abcdefg")) - s = - "foo(" <> Text.intercalate "," - (map (abiTypeSolidity . abiValueType) args) <> ")" - - runFunction [i| - function foo(${params}) public pure returns (${abiTypeSolidity t} ${defaultDataLocation t} x) { - ${stmts} - } - |] (abiMethod s (AbiTuple $ Vector.fromList args)) - -getStaticAbiArgs :: VM -> [SWord 256] -getStaticAbiArgs vm = - let cd = view (state . calldata . _1) vm - bs = case cd of - ConcreteBuffer bs' -> ConcreteBuffer $ BS.drop 4 bs' - SymbolicBuffer bs' -> SymbolicBuffer $ drop 4 bs' - args = decodeStaticArgs bs - in fmap (\(S _ v) -> v) args - --- includes shaving off 4 byte function sig -decodeAbiValues :: [AbiType] -> ByteString -> [AbiValue] -decodeAbiValues types bs = - let AbiTuple xy = decodeAbiValue (AbiTupleType $ Vector.fromList types) (BS.fromStrict (BS.drop 4 bs)) - in Vector.toList xy - -newtype Bytes = Bytes ByteString - deriving Eq - -instance Show Bytes where - showsPrec _ (Bytes x) _ = show (BS.unpack x) - -instance Arbitrary Bytes where - arbitrary = fmap (Bytes . BS.pack) arbitrary - -newtype RLPData = RLPData RLP - deriving (Eq, Show) - --- bias towards bytestring to try to avoid infinite recursion -instance Arbitrary RLPData where - arbitrary = frequency - [(5, do - Bytes bytes <- arbitrary - return $ RLPData $ BS bytes) - , (1, do - k <- choose (0,10) - ls <- vectorOf k arbitrary - return $ RLPData $ List [r | RLPData r <- ls]) - ] - -data Invocation - = SolidityCall Text [AbiValue] - deriving Show - -assertSolidityComputation :: Invocation -> AbiValue -> IO () -assertSolidityComputation (SolidityCall s args) x = - do y <- runStatements s args (abiValueType x) - assertEqual (Text.unpack s) - (fmap Bytes (Just (encodeAbiValue x))) - (fmap Bytes y) - -bothM :: (Monad m) => (a -> m b) -> (a, a) -> m (b, b) -bothM f (a, a') = do - b <- f a - b' <- f a' - return (b, b') - -applyPattern :: String -> TestTree -> TestTree -applyPattern p = localOption (TestPattern (parseExpr p)) diff --git a/src/jays/src/Jays.hs b/src/jays/src/Jays.hs index 3fc53388a..acc13284d 100644 --- a/src/jays/src/Jays.hs +++ b/src/jays/src/Jays.hs @@ -18,7 +18,8 @@ import Text.Read (readMaybe) import qualified Data.Aeson.Encode.Pretty as Encode import qualified Data.ByteString.Lazy as BS -import qualified Data.HashMap.Lazy as Map +import qualified Data.Aeson.KeyMap as KM +import qualified Data.Aeson.Key as K data Op = OpNewValue Value @@ -147,7 +148,7 @@ work stk ops = (xs, OpNewValue v : ops') -> work (v : xs) ops' (v : Object o : xs, OpInsert k : ops') -> - work (Object (Map.insert k v o) : xs) ops' + work (Object (KM.insert (K.fromText k) v o) : xs) ops' (v : Array o : xs, OpInsert "append" : ops') -> work (Array (snoc o v) : xs) ops' (_, OpInsert "append" : _) -> @@ -156,7 +157,7 @@ work stk ops = Left "error in -i" (Object o : xs, OpExtract k : ops') -> - case Map.lookup k o of + case KM.lookup (K.fromText k) o of Nothing -> Left ("error in -e: no such key: " <> k) Just x -> @@ -185,7 +186,7 @@ work stk ops = Left "error in -t" (Object o : xs, OpKeys : ops') -> - (map (fromStrict . encodeUtf8) (sort (Map.keys o)) ++) <$> work xs ops' + (map (fromStrict . encodeUtf8) (sort (map K.toText $ KM.keys o)) ++) <$> work xs ops' (_, OpKeys : _) -> Left "error in -k" diff --git a/src/seth/CHANGELOG.md b/src/seth/CHANGELOG.md index f20ba2400..63f919460 100644 --- a/src/seth/CHANGELOG.md +++ b/src/seth/CHANGELOG.md @@ -4,6 +4,16 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased] + +### Added + +- Support for installing and running with [experimental nix commands](https://nixos.org/manual/nix/stable/command-ref/experimental-commands.html) + +### Fixed + +- `seth --nix-run` invocations + ## [0.12.0] - 2021-11-12 ### Changed diff --git a/src/seth/default.nix b/src/seth/default.nix index 8c8eaf6c8..701d42a33 100644 --- a/src/seth/default.nix +++ b/src/seth/default.nix @@ -1,6 +1,27 @@ -{ lib, stdenv, fetchFromGitHub, makeWrapper, glibcLocales, solc, nix -, bc, coreutils, curl, ethsign, git, gnused, jq, jshon, nodejs, tre, perl -, gnugrep, hevm, shellcheck, dapptoolsSrc }: +{ lib +, stdenv +, fetchFromGitHub +, makeWrapper +, glibcLocales +, solc +, nix +, bc +, coreutils +, curl +, ethsign +, git +, gnused +, jq +, jshon +, nodejs +, tre +, perl +, gnugrep +, hevm +, shellcheck +, dapptoolsSrc +, eth-utils +}: stdenv.mkDerivation rec { name = "seth-${version}"; @@ -11,23 +32,37 @@ stdenv.mkDerivation rec { dontBuild = true; doCheck = true; checkTarget = "test"; - makeFlags = ["prefix=$(out)"]; + makeFlags = [ "prefix=$(out)" ]; postInstall = let path = lib.makeBinPath [ - bc coreutils curl ethsign git gnused nix jq hevm jshon nodejs tre perl solc + bc + coreutils + curl + ethsign + eth-utils + git gnugrep + gnused + hevm + jq + jshon + nix + nodejs + perl + solc + tre ]; in - '' + '' wrapProgram "$out/bin/seth" \ --prefix PATH : ${path} \ --set DAPPTOOLS ${dapptoolsSrc} \ ${lib.optionalString (glibcLocales != null) '' --set LOCALE_ARCHIVE ${glibcLocales}/lib/locale/locale-archive ''} - ''; + ''; # the patching of nodejs shebangs is needed by the seth invocations in # src/dapp-tests/integration/tests.sh. @@ -39,7 +74,7 @@ stdenv.mkDerivation rec { meta = { description = "Command-line client for talking to Ethereum nodes"; homepage = https://github.com/dapphub/dapptools/src/seth/; - maintainers = [lib.maintainers.dbrock]; + maintainers = [ lib.maintainers.dbrock ]; license = lib.licenses.gpl3; inherit version; }; diff --git a/src/seth/libexec/seth/seth---nix-run b/src/seth/libexec/seth/seth---nix-run index 85fd12c7d..5e7c675eb 100755 --- a/src/seth/libexec/seth/seth---nix-run +++ b/src/seth/libexec/seth/seth---nix-run @@ -1,7 +1,7 @@ #!/usr/bin/env bash # Usage: seth --nix-run PKG COMMAND... # Example: -# $ seth --nix-run go-ethereum geth --version +# $ seth --nix-run go-ethereum version # # Runs a command with the binaries from a named Nix package in PATH. @@ -16,4 +16,4 @@ have() { command -v "$1" >/dev/null; } expr="$1"; shift -nix run "(with import $DAPPTOOLS {}; $expr)" -c "$@" +nix run --impure --expr "with import $DAPPTOOLS {}; $expr" out -- "$@" diff --git a/src/seth/libexec/seth/seth---use b/src/seth/libexec/seth/seth---use index 4c8d91980..9c70bb446 100755 --- a/src/seth/libexec/seth/seth---use +++ b/src/seth/libexec/seth/seth---use @@ -16,6 +16,11 @@ query() { nix-env -q --installed --out-path --no-name "$1" 2>/dev/null } +# Profiles created with the experimental nix commands are incompatible with nix-env ones, so we need to handle them separately. +query_nix3() { + nix profile list 2>/dev/null | grep "$1" +} + shopt -s extglob case $1 in # package spec e.g. solc:0.4.12 @@ -25,6 +30,9 @@ case $1 in bin="$store_path/bin/solc" elif store_path=$(query "solc-static-${1#solc:}"); then bin="$store_path/bin/$solc" + elif output=$(query_nix3 "solc-static-${1#solc:}"); then + store_path=$(echo "$output" | cut -d " " -f 4) + bin="$store_path/bin/$solc" else bin="" fi @@ -48,14 +56,10 @@ shift [[ "$#" -gt 0 ]] || usage if [[ -z "$bin" ]]; then - echo >&2 "${0##*/}: Could not find ${solc} in your path or nix store." - echo >&2 "Temporarily installing ${solc}..." - echo >&2 "Tip: run \`nix-env -f https://github.com/dapphub/dapptools/archive/master.tar.gz -iA solc-static-versions.${solc//[-.]/_}\` for a lasting installation of this version." - seth --nix-run "seth.override {solc = pkgs.runCommand \"solc\" { } \"mkdir -p \$out/bin; ln -s \${solc-static-versions.${solc//[-.]/_}}/bin/${solc} \$out/bin/solc\";}" seth "$@" - + seth --nix-run "seth.override {solc = pkgs.runCommand \"solc\" { } \"mkdir -p \$out/bin; ln -s \${solc-static-versions.${solc//[-.]/_}}/bin/${solc} \$out/bin/solc\";}" "$@" else set -e SOLCBIN="$(realpath -e "${bin}")" -fi -DAPP_SOLC="$SOLCBIN" seth "$@" + DAPP_SOLC="$SOLCBIN" seth "$@" +fi diff --git a/src/seth/libexec/seth/seth-calldata b/src/seth/libexec/seth/seth-calldata index 2d625208a..e071f2056 100755 --- a/src/seth/libexec/seth/seth-calldata +++ b/src/seth/libexec/seth/seth-calldata @@ -19,7 +19,7 @@ if [[ $1 =~ ^([^\(]+)\( ]]; then args+=(--arg "$arg") done calldata=$( - hevm abiencode --abi "$abi" "${args[@]}" + eth-utils abiencode --abi "$abi" "${args[@]}" ) if [[ $calldata = error* ]]; then echo >&2 "hevm: $calldata" diff --git a/src/seth/libexec/seth/seth-sig b/src/seth/libexec/seth/seth-sig index 8d4ab663d..f3ff87eef 100755 --- a/src/seth/libexec/seth/seth-sig +++ b/src/seth/libexec/seth/seth-sig @@ -28,5 +28,5 @@ for input in $inputs; do done # Use dummy args generate calldata and only keep the function selector -calldata=$(hevm abiencode --abi "$abi" "${args[@]}") +calldata=$(eth-utils abiencode --abi "$abi" "${args[@]}") echo "${calldata:0:10}"