diff --git a/.gitignore b/.gitignore
index 065477ab1..52f26081e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,4 @@
*~
cache/*
Version.ml
+/_opam/
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 0fb22a317..6b5a86e70 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -9,34 +9,21 @@ stages:
- test
.website_build: &website_build
- stage: build_and_deploy_website
+ stage: test # TODO DODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODO restore to build_and_deploy_website
image: node:8
before_script:
- scripts/install_native_dependencies.sh
- # TODO: these things are moved to scripts in other branches.
- - wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O opam-2.0.1-x86_64-linux
- - cp opam-2.0.1-x86_64-linux /usr/local/bin/opam
- - chmod +x /usr/local/bin/opam
+ - scripts/install_opam.sh # TODO: or scripts/install_build_environment.sh ?
- export PATH="/usr/local/bin${PATH:+:}${PATH:-}"
-
- # Initialise opam
- - printf '' | opam init --bare
- eval $(opam config env)
-
- # Create switch
- - printf '' | opam switch create toto ocaml-base-compiler.4.06.1
+ - scripts/setup_switch.sh
- eval $(opam config env)
-
- # Show versions and current switch
- - echo "$PATH"
- - opam --version
- - printf '' | ocaml
- - opam switch
+ - scripts/debug_show_versions.sh || true
# install deps for internal documentation
- opam install -y odoc
- - vendors/opam-repository-tools/rewrite-local-opam-repository.sh
- - opam repository add localrepo "file://$PWD/vendors/ligo-opam-repository-local-generated/"
+ # - vendors/opam-repository-tools/rewrite-local-opam-repository.sh
+ # - opam repository add localrepo "file://$PWD/vendors/ligo-opam-repository-local-generated/"
- opam install -y --build-test --deps-only ./src/
- dune build -p ligo
# TODO: also try instead from time to time:
@@ -75,44 +62,36 @@ stages:
before_script:
# Install dependencies
# rsync is needed by opam to sync a package installed from a local directory with the copy in ~/.opam
- - apt-get update -qq
- scripts/install_native_dependencies.sh
- - scripts/install_opam.sh
+ - scripts/install_opam.sh # TODO: or scripts/install_build_environment.sh ?
- export PATH="/usr/local/bin${PATH:+:}${PATH:-}"
-
- # Initialise opam, create switch, load opam environment variables
- - printf '' | opam init --bare
- - printf '' | opam switch create ligo-switch ocaml-base-compiler.4.06.1
+ - echo "$PATH"; which ocaml || true
- eval $(opam config env)
-
- # Show versions and current switch
- - echo "$PATH"
- - opam --version
- - printf '' | ocaml
- - opam switch
+ - echo "$PATH"; which ocaml || true
+ - scripts/setup_switch.sh
+ - echo "$PATH"; which ocaml || true
+ - eval $(opam config env)
+ - echo "$PATH"; which ocaml || true
+ - scripts/debug_show_versions.sh || true
local-dune-job:
<<: *before_script
stage: test
script:
- - scripts/setup_ligo_opam_repository.sh
- - opam install -y --build-test --deps-only ./src/
- - dune build -p ligo
- # TODO: also try instead from time to time:
- #- (cd ./src/; dune build -p ligo)
+ - scripts/install_vendors_deps.sh
+ - scripts/build_ligo_local.sh
- dune build @ligo-test
-# artifacts:
-# paths:
-# - src/ligo/bin/cli.ml
-local-repo-job:
- <<: *before_script
- stage: test
- script:
- - vendors/opam-repository-tools/rewrite-local-opam-repository.sh
- - opam repository add localrepo "file://$PWD/vendors/ligo-opam-repository-local-generated/"
- #--build-test
- - opam install -y ligo
+# TODO: uncomment this
+
+# TODO
+# local-repo-job:
+# <<: *before_script
+# stage: test
+# script:
+# - scripts/install_vendors_deps.sh
+# # TODO: also try from time to time with --build-test
+# - opam install -y ligo
remote-repo-job:
<<: *before_script
@@ -130,19 +109,21 @@ remote-repo-job:
only:
- master
-# Run a docker build without publishing to the registry
-build-current-docker-image:
- stage: build_docker
- <<: *docker
- <<: *docker_build
- except:
- - master
- - dev
+# TODO: uncomment this
+
+# # Run a docker build without publishing to the registry
+# build-current-docker-image:
+# stage: test # TODO DODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODO restore to build_docker
+# <<: *docker
+# <<: *docker_build
+# except:
+# - master
+# - dev
# When a MR/PR is merged to dev
# take the previous build and publish it to Docker Hub
build-and-publish-latest-docker-image:
- stage: build_and_deploy_docker
+ stage: test # TODO DODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODO restore to build_and_deploy_docker
<<: *docker
<<: *docker_build
after_script:
diff --git a/Makefile b/Makefile
index f70b9412a..21dd72cc7 100644
--- a/Makefile
+++ b/Makefile
@@ -1,3 +1,37 @@
+.ONESHELL:
+
+all: test
+
+# Use install-deps instead of 'install' because usually 'make install' adds a
+# binary to the system path and we don't want to confuse users
+install-deps:
+# Install ligo/tezos specific system-level dependencies
+ sudo scripts/install_native_dependencies.sh
+ scripts/install_build_environment.sh # TODO: or scripts/install_opam.sh ?
+
build-deps:
- scripts/install_native_dependencies.sh
- scripts/install_opam.sh
+ echo aa
+ export PATH="/usr/local/bin$${PATH:+:}$${PATH:-}"
+# Create opam dev switch locally for use with Ligo, add merlin/etc
+ if [ -n "`opam switch show | grep -P ".+/ligo"`" ];
+ then :; else scripts/setup_dev_switch.sh;
+ fi
+ echo bb
+ eval $$(opam config env)
+ echo cc
+# Install OCaml build dependencies for Ligo
+ scripts/install_vendors_deps.sh
+ echo dd
+ scripts/install_ligo_with_dependencies.sh # TODO: rename & cleanup
+ echo ee
+
+build: build-deps
+ export PATH="/usr/local/bin$${PATH:+:}$${PATH:-}"
+ eval $$(opam config env)
+# Build Ligo for local dev use
+ scripts/build_ligo_local.sh
+
+test: build
+ export PATH="/usr/local/bin$${PATH:+:}$${PATH:-}"
+ eval $$(opam config env)
+ scripts/test_ligo.sh
diff --git a/docker/Dockerfile b/docker/Dockerfile
index dbc051aee..17a80641a 100644
--- a/docker/Dockerfile
+++ b/docker/Dockerfile
@@ -19,12 +19,17 @@ WORKDIR /ligo
# Install required native dependencies
RUN sh scripts/install_native_dependencies.sh
-# Setup a custom opam repository where ligo is published
-RUN sh scripts/setup_ligo_opam_repository.sh
+# Install OPAM
+# TODO: or scripts/install_build_environment.sh ?
+RUN sh scripts/install_opam.sh
+
+# Creat opam switch
+RUN sh scripts/setup_switch.sh
RUN opam update
# Install ligo
+RUN sh scripts/install_vendors_deps.sh
RUN sh scripts/install_ligo_with_dependencies.sh
# Use the ligo binary as a default command
diff --git a/makefile b/makefile
deleted file mode 100644
index 069943f5b..000000000
--- a/makefile
+++ /dev/null
@@ -1,25 +0,0 @@
-# Use install-deps instead of 'install' because usually 'make install' adds a
-# binary to the system path and we don't want to confuse users
-install-deps:
-# Install ligo/tezos specific system-level dependencies
- sudo scripts/install_native_dependencies.sh
-
-build-deps:
-# Create opam dev switch locally for use with Ligo, add merlin/etc
- if [ -n "`opam switch show | grep -P ".+/ligo"`" ];
- then exit; else scripts/setup_dev_switch.sh;
- fi
-# Set up the local ligo opam repository so that it can be built
- if [ -n "`opam repo list --safe | grep -P "ligo-opam-repository"`" ];
- then exit; else scripts/setup_ligo_opam_repository.sh;
- fi
-# Install OCaml build dependencies for Ligo
- scripts/install_ligo_with_dependencies.sh
-
-build: build-deps
-# Build Ligo for local dev use
- scripts/build_ligo_local.sh
-
-.ONESHELL:
-test: build
- scripts/test_ligo.sh
diff --git a/scripts/build_ligo_local.sh b/scripts/build_ligo_local.sh
index 85fcb6892..8ccfd8658 100755
--- a/scripts/build_ligo_local.sh
+++ b/scripts/build_ligo_local.sh
@@ -1,2 +1,8 @@
-eval $(opam env)
-dune build -p ligo
+#!/bin/sh
+set -e
+
+eval $(opam config env)
+dune build src # TODO: make it work with -p ligo
+
+# TODO: also try instead from time to time:
+#- (cd ./src/; dune build -p ligo)
diff --git a/scripts/debug_show_versions.sh b/scripts/debug_show_versions.sh
new file mode 100755
index 000000000..1c744a566
--- /dev/null
+++ b/scripts/debug_show_versions.sh
@@ -0,0 +1,8 @@
+#!/bin/sh
+set -e
+
+echo "$PATH"
+opam --version
+printf '' | ocaml
+opam switch
+
diff --git a/scripts/install_build_environment.sh b/scripts/install_build_environment.sh
index 4d5e36400..958f855b1 100755
--- a/scripts/install_build_environment.sh
+++ b/scripts/install_build_environment.sh
@@ -1,3 +1,6 @@
+#!/bin/sh
+set -e
+
# This script installs opam for the user. It should NOT be included in any makefiles/etc.
if [ -n "`which opam`" ]
diff --git a/scripts/install_opam.sh b/scripts/install_opam.sh
index 1a89f6a9b..eb9c1c43f 100755
--- a/scripts/install_opam.sh
+++ b/scripts/install_opam.sh
@@ -1,10 +1,27 @@
#!/bin/sh
set -e
+set -x
# TODO: this has many different modes of failure (file temp.opam-2.0.1-x86_64-linux.download-in-progress already exists, /usr/local/bin/opam already exists and is a directory or hard link, …)
# Try to improve these aspects.
-wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O temp.opam-2.0.1-x86_64-linux.download-in-progress
+if command -v wget >/dev/null 2>&1; then
+ wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O temp.opam-2.0.1-x86_64-linux.download-in-progress
+else
+ curl -L https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux --output temp.opam-2.0.1-x86_64-linux.download-in-progress
+fi
+
+# debug
+ls
+apt -y install hexdump || true
+apt -y install xxd || true
+(cat temp.opam-2.0.1-x86_64-linux.download-in-progress | xxd | head -n 30) || true
+
cp -i temp.opam-2.0.1-x86_64-linux.download-in-progress /usr/local/bin/opam
chmod +x /usr/local/bin/opam
rm temp.opam-2.0.1-x86_64-linux.download-in-progress
+
+which opam || true
+
+
+opam init -a --bare
diff --git a/scripts/install_vendors_deps.sh b/scripts/install_vendors_deps.sh
new file mode 100755
index 000000000..9d2035b45
--- /dev/null
+++ b/scripts/install_vendors_deps.sh
@@ -0,0 +1,12 @@
+#!/bin/sh
+set -e
+
+# Install local dependencies
+opam install -y ./vendors/ligo-utils/simple-utils
+opam install -y ./vendors/ligo-utils/tezos-protocol-alpha
+opam install -y ./vendors/ligo-utils/tezos-protocol-alpha-parameters
+opam install -y ./vendors/ligo-utils/memory-proto-alpha
+opam install -y ./vendors/ligo-utils/tezos-utils/michelson-parser
+opam install -y ./vendors/ligo-utils/tezos-utils
+opam install -y ./vendors/ligo-utils/proto-alpha-utils
+opam install -y getopt ppx_deriving menhir
diff --git a/scripts/setup_dev_switch.sh b/scripts/setup_dev_switch.sh
index 5b9ea1dca..88662c79a 100755
--- a/scripts/setup_dev_switch.sh
+++ b/scripts/setup_dev_switch.sh
@@ -1,4 +1,7 @@
-opam switch create . ocaml-base-compiler.4.06.1
-eval $(opam env)
+#!/bin/sh
+set -e
+
+"$(dirname "$0")"/setup_switch.sh
+
opam install -y ocp-indent tuareg merlin alcotest-lwt crowbar
opam -y user-setup install
diff --git a/scripts/setup_switch.sh b/scripts/setup_switch.sh
new file mode 100755
index 000000000..070e720a7
--- /dev/null
+++ b/scripts/setup_switch.sh
@@ -0,0 +1,15 @@
+#!/bin/sh
+set -e
+set -x
+
+printf '' | opam switch create . 4.07.1 # toto ocaml-base-compiler.4.06.1
+eval $(opam config env)
+
+# Add Tezos opam repository
+opam repo add tezos-opam-repository https://gitlab.com/nomadic-labs/tezos-opam-repository.git
+
+# TODO: move this to install_vendor_deps.sh
+# Pin the versions of some dependencies
+opam pin -y zarith 1.7
+opam pin -y ipaddr 3.1.0
+opam pin -y macaddr 3.1.0
diff --git a/scripts/test_ligo.sh b/scripts/test_ligo.sh
index d13e26d3d..9fd6320e7 100755
--- a/scripts/test_ligo.sh
+++ b/scripts/test_ligo.sh
@@ -1,2 +1,5 @@
-eval $(opam env)
+#!/bin/sh
+set -e
+
+eval $(opam config env)
dune build @ligo-test
diff --git a/src/README_INSTALL b/src/README_INSTALL
deleted file mode 100644
index 431f6ac8d..000000000
--- a/src/README_INSTALL
+++ /dev/null
@@ -1,20 +0,0 @@
-switch=titi
-cd src/ligo
-sudo apt -y install libev-dev libhidapi-dev
-opam init
-eval $(opam env)
-opam switch create $switch ocaml-base-compiler.4.06.1
-eval $(opam env --switch=$switch --set-switch)
-opam repository add new-tezos https://gitlab.com/ligolang/new-tezos-opam-repository.git
-
-# si une build a déjà été tentée, il vaut mieux git add tout ce qui est utile et git clean -dfx pour supprimer tout le reste (dune 1.7 crée des fichiers non compatibles avec dune 1.6)
-opam install -y ocplib-endian alcotest
-
-(cd ligo-parser && opam install -y .)
-eval $(opam env)
-(cd ligo-helpers && opam install -y .)
-eval $(opam env)
-(opam install -y .)
-eval $(opam env)
-opam install merlin ocp-indent ledit
-opam user-setup install
diff --git a/src/ast_simplified/dune b/src/ast_simplified/dune
index b3a3f0f44..922e2d466 100644
--- a/src/ast_simplified/dune
+++ b/src/ast_simplified/dune
@@ -6,7 +6,7 @@
tezos-utils
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -open Simple_utils ))
)
diff --git a/src/ast_simplified/types.ml b/src/ast_simplified/types.ml
index 3eb0990cb..88b93beda 100644
--- a/src/ast_simplified/types.ml
+++ b/src/ast_simplified/types.ml
@@ -92,7 +92,7 @@ and literal =
| Literal_bytes of bytes
| Literal_address of string
| Literal_timestamp of int
- | Literal_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
+ | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
and 'a matching =
| Match_bool of {
diff --git a/src/ast_typed/dune b/src/ast_typed/dune
index ed65217e9..a74add3b6 100644
--- a/src/ast_typed/dune
+++ b/src/ast_typed/dune
@@ -7,7 +7,7 @@
ast_simplified ; Is that a good idea?
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -open Simple_utils))
)
diff --git a/src/ast_typed/types.ml b/src/ast_typed/types.ml
index 65524fde8..cf8c40fec 100644
--- a/src/ast_typed/types.ml
+++ b/src/ast_typed/types.ml
@@ -122,7 +122,7 @@ and literal =
| Literal_string of string
| Literal_bytes of bytes
| Literal_address of string
- | Literal_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
+ | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
and access =
| Access_tuple of int
diff --git a/src/bin/dune b/src/bin/dune
index b970a8805..1e08c1acf 100644
--- a/src/bin/dune
+++ b/src/bin/dune
@@ -8,7 +8,7 @@
)
(package ligo)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -open Simple_utils))
)
diff --git a/src/compiler/compiler_environment.ml b/src/compiler/compiler_environment.ml
index d5734c4e9..dc145c7a9 100644
--- a/src/compiler/compiler_environment.ml
+++ b/src/compiler/compiler_environment.ml
@@ -3,12 +3,9 @@ open Trace
open Mini_c
open Environment
open Michelson
-open Memory_proto_alpha.Script_ir_translator
-
-module Stack = Meta_michelson.Stack
let get : environment -> string -> michelson result = fun e s ->
- let%bind (type_value , position) =
+ let%bind (_type_value , position) =
let error =
let title () = "Environment.get" in
let content () = Format.asprintf "%s in %a"
@@ -26,22 +23,10 @@ let get : environment -> string -> michelson result = fun e s ->
in
let code = aux position in
- let%bind () =
- let error () = ok @@ simple_error "error producing Env.get" in
- let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
- let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
- let output_stack_ty = Stack.(ty @: input_stack_ty) in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
let set : environment -> string -> michelson result = fun e s ->
- let%bind (type_value , position) =
+ let%bind (_type_value , position) =
generic_try (simple_error "Environment.get") @@
(fun () -> Environment.get_i s e) in
let rec aux = fun n ->
@@ -54,37 +39,11 @@ let set : environment -> string -> michelson result = fun e s ->
in
let code = aux position in
- let%bind () =
- let error () = ok @@ simple_error "error producing Env.set" in
- let%bind (Stack.Ex_stack_ty env_stack_ty) = Compiler_type.Ty.environment e in
- let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
- let input_stack_ty = Stack.(ty @: env_stack_ty) in
- let output_stack_ty = env_stack_ty in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
-let add : environment -> (string * type_value) -> michelson result = fun e (_s , type_value) ->
+let add : environment -> (string * type_value) -> michelson result = fun _e (_s , _type_value) ->
let code = seq [] in
- let%bind () =
- let error () = ok @@ simple_error "error producing Env.get" in
- let%bind (Stack.Ex_stack_ty env_stack_ty) = Compiler_type.Ty.environment e in
- let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
- let input_stack_ty = Stack.(ty @: env_stack_ty) in
- let output_stack_ty = Stack.(ty @: env_stack_ty) in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
let select ?(rev = false) ?(keep = true) : environment -> string list -> michelson result = fun e lst ->
@@ -111,32 +70,6 @@ let select ?(rev = false) ?(keep = true) : environment -> string list -> michels
in
List.fold_right' aux (seq []) e_lst in
- let%bind () =
- let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
- let e' =
- Environment.of_list
- @@ List.map fst
- @@ List.filter snd
- @@ e_lst
- in
- let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment e' in
- let error () =
- let title () = "error producing Env.select" in
- let content () = Format.asprintf "\nInput : %a\nOutput : %a\nList : {%a}\nCode : %a\nLog : %s\n"
- PP.environment e
- PP.environment e'
- PP_helpers.(list_sep (pair PP.environment_element bool) (const " || ")) e_lst
- Michelson.pp code
- (L.get ())
- in
- ok @@ (error title content) in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
let select_env : environment -> environment -> michelson result = fun source filter ->
@@ -158,23 +91,6 @@ let pack : environment -> michelson result = fun e ->
Assert.assert_true (List.length e <> 0) in
let code = seq @@ List.map (Function.constant i_pair) @@ List.tl e in
- let%bind () =
- let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
- let repr = Environment.closure_representation e in
- let%bind (Ex_ty output_ty) = Compiler_type.Ty.type_ repr in
- let output_stack_ty = Stack.(output_ty @: nil) in
- let error () =
- let title () = "error producing Env.pack" in
- let content () = Format.asprintf ""
- in
- ok @@ (error title content) in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
let unpack : environment -> michelson result = fun e ->
@@ -192,26 +108,6 @@ let unpack : environment -> michelson result = fun e ->
] in
let code = aux l in
- let%bind () =
- let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment e in
- let repr = Environment.closure_representation e in
- let%bind (Ex_ty input_ty) = Compiler_type.Ty.type_ repr in
- let input_stack_ty = Stack.(input_ty @: nil) in
- let error () =
- let title () = "error producing Env.unpack" in
- let content () = Format.asprintf "\nEnvironment:%a\nType Representation:%a\nCode:%a\n"
- PP.environment e
- PP.type_ repr
- Michelson.pp code
- in
- ok @@ (error title content) in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
@@ -239,53 +135,11 @@ let pack_select : environment -> string list -> michelson result = fun e lst ->
in
List.fold_right' aux (true , seq []) e_lst in
- let%bind () =
- let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
- let e' =
- Environment.of_list
- @@ List.map fst
- @@ List.filter snd
- @@ e_lst
- in
- let%bind (Ex_ty output_ty) = Compiler_type.Ty.environment_representation e' in
- let output_stack_ty = Stack.(output_ty @: input_stack_ty) in
- let error () =
- let title () = "error producing Env.pack_select" in
- let content () = Format.asprintf "\nInput : %a\nOutput : %a\nList : {%a}\nCode : %a\nLog : %s\n"
- PP.environment e
- PP.environment e'
- PP_helpers.(list_sep (pair PP.environment_element bool) (const " || ")) e_lst
- Michelson.pp code
- (L.get ())
- in
- ok @@ (error title content) in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
-let add_packed_anon : environment -> type_value -> michelson result = fun e type_value ->
+let add_packed_anon : environment -> type_value -> michelson result = fun _e _type_value ->
let code = seq [i_pair] in
- let%bind () =
- let error () = ok @@ simple_error "error producing add packed" in
- let%bind (Ex_ty input_ty) = Compiler_type.Ty.environment_representation e in
- let e' = Environment.add ("_add_packed_anon" , type_value) e in
- let%bind (Ex_ty output_ty) = Compiler_type.Ty.environment_representation e' in
- let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
- let input_stack_ty = Stack.(ty @: input_ty @: nil) in
- let output_stack_ty = Stack.(output_ty @: nil) in
- let%bind _ =
- Trace.trace_tzresult_lwt_r error @@
- Memory_proto_alpha.parse_michelson code
- input_stack_ty output_stack_ty in
- ok ()
- in
-
ok code
let pop : environment -> environment result = fun e ->
diff --git a/src/compiler/compiler_program.ml b/src/compiler/compiler_program.ml
index aa737a071..329aae692 100644
--- a/src/compiler/compiler_program.ml
+++ b/src/compiler/compiler_program.ml
@@ -2,10 +2,8 @@ open Trace
open Mini_c
open Michelson
-module Stack = Meta_michelson.Stack
-module Contract_types = Meta_michelson.Types
-open Memory_proto_alpha.Script_ir_translator
+open Memory_proto_alpha.Protocol.Script_ir_translator
open Operators.Compiler
@@ -141,9 +139,9 @@ and translate_expression ?push_var_name (expr:expression) (env:environment) : (m
else ok end_env
)
in
- let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment env in
+ let%bind (Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment env in
let%bind output_type = Compiler_type.type_ ty in
- let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment env' in
+ let%bind (Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment env' in
let error_message () =
let%bind schema_michelsons = Compiler_type.environment env in
ok @@ Format.asprintf
@@ -470,10 +468,11 @@ and translate_quote_body ({result ; binder ; input} as f:anon_function) : michel
] in
let%bind _assert_type =
+ let open Memory_proto_alpha.Protocol.Script_typed_ir in
let%bind (Ex_ty input_ty) = Compiler_type.Ty.type_ f.input in
let%bind (Ex_ty output_ty) = Compiler_type.Ty.type_ f.output in
- let input_stack_ty = Stack.(input_ty @: nil) in
- let output_stack_ty = Stack.(output_ty @: nil) in
+ let input_stack_ty = Item_t (input_ty, Empty_t, None) in
+ let output_stack_ty = Item_t (output_ty, Empty_t, None) in
let error_message () =
Format.asprintf
"\nCode : %a\nMichelson code : %a\ninput : %a\noutput : %a\nstart env : %a\nend env : %a\n"
diff --git a/src/compiler/compiler_type.ml b/src/compiler/compiler_type.ml
index 5977db461..61fbac6f5 100644
--- a/src/compiler/compiler_type.ml
+++ b/src/compiler/compiler_type.ml
@@ -2,18 +2,52 @@ open Trace
open Mini_c.Types
open Proto_alpha_utils.Memory_proto_alpha
+open Protocol
open Script_ir_translator
module O = Tezos_utils.Michelson
-module Contract_types = Meta_michelson.Types
module Ty = struct
let not_comparable name () = error (thunk "not a comparable type") (fun () -> name) ()
let not_compilable_type name () = error (thunk "not a compilable type") (fun () -> name) ()
+ open Script_typed_ir
+
+
+ let nat_k = Nat_key None
+ let tez_k = Mutez_key None
+ let int_k = Int_key None
+ let string_k = String_key None
+ let address_k = Address_key None
+ let timestamp_k = Timestamp_key None
+ let bytes_k = Bytes_key None
+ (* let timestamp_k = Timestamp_key None *)
+
+ let unit = Unit_t None
+ let bytes = Bytes_t None
+ let nat = Nat_t None
+ let tez = Mutez_t None
+ let int = Int_t None
+ let big_map k v = Big_map_t (k, v, None)
+ let signature = Signature_t None
+ let operation = Operation_t None
+ let bool = Bool_t None
+ let mutez = Mutez_t None
+ let string = String_t None
+ let key = Key_t None
+ let list a = List_t (a, None)
+ let set a = Set_t (a, None)
+ let address = Address_t None
+ let option a = Option_t ((a, None), None, None)
+ let contract a = Contract_t (a, None)
+ let lambda a b = Lambda_t (a, b, None)
+ let timestamp = Timestamp_t None
+ let map a b = Map_t (a, b, None)
+ let pair a b = Pair_t ((a, None, None), (b, None, None), None)
+ let union a b = Union_t ((a, None), (b, None), None)
+
let comparable_type_base : type_base -> ex_comparable_ty result = fun tb ->
- let open Contract_types in
let return x = ok @@ Ex_comparable_ty x in
match tb with
| Base_unit -> fail (not_comparable "unit")
@@ -42,7 +76,6 @@ module Ty = struct
| T_contract _ -> fail (not_comparable "contract")
let base_type : type_base -> ex_ty result = fun b ->
- let open Contract_types in
let return x = ok @@ Ex_ty x in
match b with
| Base_unit -> return unit
@@ -63,57 +96,56 @@ module Ty = struct
| T_pair (t, t') -> (
type_ t >>? fun (Ex_ty t) ->
type_ t' >>? fun (Ex_ty t') ->
- ok @@ Ex_ty (Contract_types.pair t t')
+ ok @@ Ex_ty (pair t t')
)
| T_or (t, t') -> (
type_ t >>? fun (Ex_ty t) ->
type_ t' >>? fun (Ex_ty t') ->
- ok @@ Ex_ty (Contract_types.union t t')
+ ok @@ Ex_ty (union t t')
)
| T_function (arg, ret) ->
let%bind (Ex_ty arg) = type_ arg in
let%bind (Ex_ty ret) = type_ ret in
- ok @@ Ex_ty (Contract_types.lambda arg ret)
+ ok @@ Ex_ty (lambda arg ret)
| T_deep_closure (c, arg, ret) ->
let%bind (Ex_ty capture) = environment_representation c in
let%bind (Ex_ty arg) = type_ arg in
let%bind (Ex_ty ret) = type_ ret in
- ok @@ Ex_ty Contract_types.(pair (lambda (pair arg capture) ret) capture)
+ ok @@ Ex_ty (pair (lambda (pair arg capture) ret) capture)
| T_map (k, v) ->
let%bind (Ex_comparable_ty k') = comparable_type k in
let%bind (Ex_ty v') = type_ v in
- ok @@ Ex_ty Contract_types.(map k' v')
+ ok @@ Ex_ty (map k' v')
| T_list t ->
let%bind (Ex_ty t') = type_ t in
- ok @@ Ex_ty Contract_types.(list t')
+ ok @@ Ex_ty (list t')
| T_set t -> (
let%bind (Ex_comparable_ty t') = comparable_type t in
- ok @@ Ex_ty Contract_types.(set t')
+ ok @@ Ex_ty (set t')
)
| T_option t ->
let%bind (Ex_ty t') = type_ t in
- ok @@ Ex_ty Contract_types.(option t')
+ ok @@ Ex_ty (option t')
| T_contract t ->
let%bind (Ex_ty t') = type_ t in
- ok @@ Ex_ty Contract_types.(contract t')
+ ok @@ Ex_ty (contract t')
and environment_representation = function
- | [] -> ok @@ Ex_ty Contract_types.unit
+ | [] -> ok @@ Ex_ty unit
| [a] -> type_ @@ snd a
| a::b ->
let%bind (Ex_ty a) = type_ @@ snd a in
let%bind (Ex_ty b) = environment_representation b in
- ok @@ Ex_ty (Contract_types.pair a b)
+ ok @@ Ex_ty (pair a b)
- and environment : environment -> Meta_michelson.Stack.ex_stack_ty result = fun env ->
- let open Meta_michelson in
+ and environment : environment -> ex_stack_ty result = fun env ->
let%bind lst =
bind_map_list type_
@@ List.map snd env in
- let aux (Stack.Ex_stack_ty st) (Ex_ty cur) =
- Stack.Ex_stack_ty (Stack.stack cur st)
+ let aux (Ex_stack_ty st) (Ex_ty cur) =
+ Ex_stack_ty (Item_t (cur, st, None))
in
- ok @@ List.fold_right' aux (Ex_stack_ty Stack.nil) lst
+ ok @@ List.fold_right' aux (Ex_stack_ty Empty_t) lst
end
diff --git a/src/compiler/dune b/src/compiler/dune
index 5f94875b8..5e4412d81 100644
--- a/src/compiler/dune
+++ b/src/compiler/dune
@@ -3,13 +3,13 @@
(public_name ligo.compiler)
(libraries
simple-utils
+ proto-alpha-utils
tezos-utils
- meta_michelson
mini_c
operators
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
)
diff --git a/src/compiler/uncompiler.ml b/src/compiler/uncompiler.ml
index 8453c6c5a..a26cccc20 100644
--- a/src/compiler/uncompiler.ml
+++ b/src/compiler/uncompiler.ml
@@ -1,6 +1,8 @@
open Mini_c.Types
-open Memory_proto_alpha
+open Proto_alpha_utils.Memory_proto_alpha
+open X
open Proto_alpha_utils.Trace
+open Protocol
open Script_typed_ir
open Script_ir_translator
diff --git a/src/dune b/src/dune
index 3fb9b193b..c2f58b54f 100644
--- a/src/dune
+++ b/src/dune
@@ -6,11 +6,10 @@
simple-utils
tezos-utils
tezos-micheline
- meta_michelson
main
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
)
@@ -29,4 +28,4 @@
(name manual-test)
(action (run test/manual_test.exe))
(deps (glob_files contracts/*))
-)
\ No newline at end of file
+)
diff --git a/src/main/dune b/src/main/dune
index 4135d0514..747afb217 100644
--- a/src/main/dune
+++ b/src/main/dune
@@ -15,7 +15,7 @@
compiler
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
)
diff --git a/src/main/run_mini_c.ml b/src/main/run_mini_c.ml
index 5c8f12e5d..7705a2b93 100644
--- a/src/main/run_mini_c.ml
+++ b/src/main/run_mini_c.ml
@@ -2,7 +2,8 @@ open Proto_alpha_utils
open Trace
open Mini_c
open! Compiler.Program
-open Memory_proto_alpha.Script_ir_translator
+open Memory_proto_alpha.Protocol.Script_ir_translator
+open Memory_proto_alpha.X
let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
let Compiler.Program.{input;output;body} : compiled_program = program in
@@ -15,8 +16,8 @@ let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) :
let%bind descr =
Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
Memory_proto_alpha.parse_michelson body
- (Stack.(input_ty @: nil)) (Stack.(output_ty @: nil)) in
- let open! Memory_proto_alpha.Script_interpreter in
+ (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in
+ let open! Memory_proto_alpha.Protocol.Script_interpreter in
let%bind (Item(output, Empty)) =
Trace.trace_tzresult_lwt (simple_error "error of execution") @@
Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in
diff --git a/src/main/run_source.ml b/src/main/run_source.ml
index a0a18be96..89afbc305 100644
--- a/src/main/run_source.ml
+++ b/src/main/run_source.ml
@@ -259,7 +259,7 @@ let run_contract ?amount source_filename entry_point storage input syntax =
parsify_expression syntax input in
let options =
let open Proto_alpha_utils.Memory_proto_alpha in
- let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
+ let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
(make_options ?amount ()) in
Run_simplified.run_simplityped ~options typed entry_point (Ast_simplified.e_pair storage_simpl input_simpl)
@@ -271,7 +271,7 @@ let run_function ?amount source_filename entry_point parameter syntax =
parsify_expression syntax parameter in
let options =
let open Proto_alpha_utils.Memory_proto_alpha in
- let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
+ let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
(make_options ?amount ()) in
Run_simplified.run_simplityped ~options typed entry_point parameter'
@@ -281,6 +281,6 @@ let evaluate_value ?amount source_filename entry_point syntax =
type_file syntax source_filename in
let options =
let open Proto_alpha_utils.Memory_proto_alpha in
- let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
+ let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
(make_options ?amount ()) in
Run_simplified.evaluate_simplityped ~options typed entry_point
diff --git a/src/meta_michelson/alpha_wrap.ml b/src/meta_michelson/alpha_wrap.ml
deleted file mode 100644
index b456ea335..000000000
--- a/src/meta_michelson/alpha_wrap.ml
+++ /dev/null
@@ -1,30 +0,0 @@
-open Proto_alpha_utils.Error_monad
-
-let dummy_environment = force_lwt ~msg:"getting dummy env" @@ Misc.init_environment ()
-
-let tc = dummy_environment.tezos_context
-
-module Proto_alpha = Proto_alpha_utils.Memory_proto_alpha
-open Proto_alpha
-open Alpha_context
-open Alpha_environment
-
-let pack ty v = fst @@ force_lwt_alpha ~msg:"packing" @@ Script_ir_translator.pack_data tc ty v
-let unpack_opt (type a) : a Script_typed_ir.ty -> MBytes.t -> a option = fun ty bytes ->
- force_lwt ~msg:"unpacking : parse" (
- if Compare.Int.(MBytes.length bytes >= 1) &&
- Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05) then
- let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in
- match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
- | None -> return None
- | Some expr ->
- Script_ir_translator.parse_data tc ty (Micheline.root expr) >>=?? fun x -> return (Some (fst x))
- else
- return None
- )
-
-let unpack ty a = match unpack_opt ty a with
- | None -> raise @@ Failure "unpacking : of_bytes"
- | Some x -> x
-
-let blake2b b = Alpha_environment.Raw_hashes.blake2b b
diff --git a/src/meta_michelson/contract.ml b/src/meta_michelson/contract.ml
deleted file mode 100644
index a9174a098..000000000
--- a/src/meta_michelson/contract.ml
+++ /dev/null
@@ -1,317 +0,0 @@
-open Misc
-
-open Proto_alpha_utils.Error_monad
-open Memory_proto_alpha
-open Alpha_context
-
-open Script_ir_translator
-open Script_typed_ir
-
-module Option = Simple_utils.Option
-module Cast = Proto_alpha_utils.Cast
-
-type ('param, 'storage) toplevel = {
- param_type : 'param ty ;
- storage_type : 'storage ty ;
- code : ('param * 'storage, packed_internal_operation list * 'storage) lambda
-}
-
-type ex_toplevel =
- Ex_toplevel : ('a, 'b) toplevel -> ex_toplevel
-
-let get_toplevel ?environment toplevel_path claimed_storage_type claimed_parameter_type =
- let toplevel_str = Streams.read_file toplevel_path in
- contextualize ?environment ~msg:"toplevel" @@ fun {tezos_context = context ; _ } ->
- let toplevel_expr = Cast.tl_of_string toplevel_str in
- let (param_ty_node, storage_ty_node, code_field) =
- force_ok_alpha ~msg:"parsing toplevel" @@
- parse_toplevel toplevel_expr in
- let (Ex_ty param_type, _) =
- force_ok_alpha ~msg:"parse arg ty" @@
- Script_ir_translator.parse_ty context ~allow_big_map:false ~allow_operation:false param_ty_node in
- let (Ex_ty storage_type, _) =
- force_ok_alpha ~msg:"parse storage ty" @@
- parse_storage_ty context storage_ty_node in
- let _ = force_ok_alpha ~msg:"storage eq" @@ Script_ir_translator.ty_eq context storage_type claimed_storage_type in
- let _ = force_ok_alpha ~msg:"param eq" @@ Script_ir_translator.ty_eq context param_type claimed_parameter_type in
- let param_type_full = Pair_t ((claimed_parameter_type, None, None),
- (claimed_storage_type, None, None), None) in
- let ret_type_full =
- Pair_t ((List_t (Operation_t None, None), None, None),
- (claimed_storage_type, None, None), None) in
- parse_returning (Toplevel { storage_type = claimed_storage_type ; param_type = claimed_parameter_type })
- context (param_type_full, None) ret_type_full code_field >>=?? fun (code, _) ->
- Error_monad.return {
- param_type = claimed_parameter_type;
- storage_type = claimed_storage_type;
- code ;
- }
-
-let make_toplevel code storage_type param_type =
- { param_type ; storage_type ; code }
-
-module type ENVIRONMENT = sig
- val identities : identity list
- val tezos_context : t
-end
-
-type ex_typed_stack = Ex_typed_stack : ('a stack_ty * 'a Script_interpreter.stack) -> ex_typed_stack
-
-open Error_monad
-
-module Step (Env: ENVIRONMENT) = struct
- open Env
-
- type config = {
- source : Contract.t option ;
- payer : Contract.t option ;
- self : Contract.t option ;
- visitor : (Script_interpreter.ex_descr_stack -> unit) option ;
- timestamp : Script_timestamp.t option ;
- debug_visitor : (ex_typed_stack -> unit) option ;
- amount : Tez.t option ;
- }
-
- let no_config = {
- source = None ;
- payer = None ;
- self = None ;
- visitor = None ;
- debug_visitor = None ;
- timestamp = None ;
- amount = None ;
- }
-
- let of_param base param = match param with
- | None -> base
- | Some _ as x -> x
-
- let make_config ?base_config ?source ?payer ?self ?visitor ?debug_visitor ?timestamp ?amount () =
- let base_config = Option.unopt ~default:no_config base_config in {
- source = Option.bind_eager_or source base_config.source ;
- payer = Option.bind_eager_or payer base_config.payer ;
- self = Option.bind_eager_or self base_config.self ;
- visitor = Option.bind_eager_or visitor base_config.visitor ;
- debug_visitor = Option.bind_eager_or debug_visitor base_config.debug_visitor ;
- timestamp = Option.bind_eager_or timestamp base_config.timestamp ;
- amount = Option.bind_eager_or amount base_config.amount ;
- }
-
- open Error_monad
-
- let debug_visitor ?f () =
- let open Script_interpreter in
- let aux (Ex_descr_stack (descr, stack)) =
- (match (descr.instr, descr.bef) with
- | Nop, Item_t (String_t _, stack_ty, _) -> (
- let (Item (s, stack)) = stack in
- if s = "_debug"
- then (
- match f with
- | None -> Format.printf "debug: %s\n%!" @@ Cast.stack_to_string stack_ty stack
- | Some f -> f (Ex_typed_stack(stack_ty, stack))
- ) else ()
- )
- | _ -> ()) ;
- () in
- aux
-
- let step_lwt ?(config=no_config) (stack:'a Script_interpreter.stack) (code:('a, 'b) descr) =
- let source = Option.unopt
- ~default:(List.nth identities 0).implicit_contract config.source in
- let payer = Option.unopt
- ~default:(List.nth identities 1).implicit_contract config.payer in
- let self = Option.unopt
- ~default:(List.nth identities 2).implicit_contract config.self in
- let amount = Option.unopt ~default:(Tez.one) config.amount in
- let visitor =
- let default = debug_visitor ?f:config.debug_visitor () in
- Option.unopt ~default config.visitor in
- let tezos_context = match config.timestamp with
- | None -> tezos_context
- | Some s -> Alpha_context.Script_timestamp.set_now tezos_context s in
- Script_interpreter.step tezos_context ~source ~payer ~self ~visitor amount code stack >>=?? fun (stack, _) ->
- return stack
-
- let step_1_2 ?config (a:'a) (descr:('a * end_of_stack, 'b * ('c * end_of_stack)) descr) =
- let open Script_interpreter in
- step_lwt ?config (Item(a, Empty)) descr >>=? fun (Item(b, Item(c, Empty))) ->
- return (b, c)
-
- let step_3_1 ?config (a:'a) (b:'b) (c:'c)
- (descr:('a * ('b * ('c * end_of_stack)), 'd * end_of_stack) descr) =
- let open Script_interpreter in
- step_lwt ?config (Item(a, Item(b, Item(c, Empty)))) descr >>=? fun (Item(d, Empty)) ->
- return d
-
- let step_2_1 ?config (a:'a) (b:'b) (descr:('a * ('b * end_of_stack), 'c * end_of_stack) descr) =
- let open Script_interpreter in
- step_lwt ?config (Item(a, Item(b, Empty))) descr >>=? fun (Item(c, Empty)) ->
- return c
-
- let step_1_1 ?config (a:'a) (descr:('a * end_of_stack, 'b * end_of_stack) descr) =
- let open Script_interpreter in
- step_lwt ?config (Item(a, Empty)) descr >>=? fun (Item(b, Empty)) ->
- return b
-
- let step_value ?config (a:'a) (descr:('a * end_of_stack, 'a * end_of_stack) descr) =
- step_1_1 ?config a descr
-
- let step ?config stack code =
- force_lwt ~msg:"running a step" @@ step_lwt ?config stack code
-
-end
-
-let run_lwt_full ?source ?payer ?self toplevel storage param {identities ; tezos_context = context} =
- let { code ; _ } : (_, _) toplevel = toplevel in
-
- let source = Option.unopt
- ~default:(List.nth identities 0).implicit_contract source in
- let payer = Option.unopt
- ~default:(List.nth identities 1).implicit_contract payer in
- let self = Option.unopt
- ~default:(List.nth identities 2).implicit_contract self in
- let amount = Tez.one in
-
- Script_interpreter.interp context ~source ~payer ~self amount code (param, storage)
- >>=?? fun ((ops, storage), new_ctxt) ->
- let gas = Alpha_context.Gas.consumed ~since:context ~until:new_ctxt in
- return (storage, ops, gas)
-
-let run_lwt ?source ?payer ?self toplevel storage param env =
- run_lwt_full ?source ?payer ?self toplevel storage param env >>=? fun (storage, _ops, _gas) ->
- return storage
-
-let run ?environment toplevel storage param =
- contextualize ?environment ~msg:"run toplevel" @@ run_lwt toplevel storage param
-
-let run_node ?environment toplevel storage_node param_node =
- contextualize ?environment ~msg:"run toplevel" @@ fun {tezos_context = context ; _} ->
- let {param_type ; storage_type ; _ } = toplevel in
- parse_data context param_type param_node >>=?? fun (param, _) ->
- parse_data context storage_type storage_node >>=?? fun (storage, _) ->
- let storage = run toplevel storage param in
- unparse_data context Readable storage_type storage >>=?? fun (storage_node, _) ->
- return storage_node
-
-let run_str toplevel storage_str param_str =
- let param_node = Cast.node_of_string param_str in
- let storage_node = Cast.node_of_string storage_str in
- run_node toplevel storage_node param_node
-
-type input = {
- toplevel_path : string ;
- storage : string ;
- parameter : string
-}
-
-let parse_json json_str : input =
- let json = force_ok_str ~msg:"main_contract: invalid json" @@ Tezos_utils.Data_encoding.Json.from_string json_str in
- let json = match json with
- | `O json -> json
- | _ -> raise @@ Failure "main_contract: not recorD"
- in
- let open Json in
- let toplevel_path = force_string ~msg:"main_contract, top_level" @@ List.assoc "top_level" json in
- let parameter = force_string ~msg:"main_contract, param" @@ List.assoc "param" json in
- let storage = force_string ~msg:"main_contract, storage" @@ List.assoc "storage" json in
- { toplevel_path ; storage ; parameter }
-
-let generate_json (storage_node:Script.node) : string =
- let storage_expr = Tezos_micheline.Micheline.strip_locations storage_node in
- let json = Data_encoding.Json.construct Script.expr_encoding storage_expr in
- Format.fprintf Format.str_formatter "%a" Data_encoding.Json.pp json ;
- Format.flush_str_formatter ()
-
-module Types = struct
- open Script_typed_ir
-
- let union a b = Union_t ((a, None), (b, None), None)
- let assert_union = function
- | Union_t ((a, _), (b, _), _) -> (a, b)
- | _ -> assert false
-
- let pair a b = Pair_t ((a, None, None), (b, None, None), None)
- let assert_pair = function
- | Pair_t ((a, _, _), ((b, _, _)), _) -> (a, b)
- | _ -> assert false
- let assert_pair_ex ?(msg="assert pair") (Ex_ty ty) = match ty with
- | Pair_t ((a, _, _), ((b, _, _)), _) -> (Ex_ty a, Ex_ty b)
- | _ -> raise (Failure msg)
-
- let unit = Unit_t None
-
- let bytes = Bytes_t None
- let bytes_k = Bytes_key None
-
- let nat = Nat_t None
- let tez = Mutez_t None
- let int = Int_t None
- let nat_k = Nat_key None
- let tez_k = Mutez_key None
- let int_k = Int_key None
-
- let big_map k v = Big_map_t (k, v, None)
-
- let signature = Signature_t None
- let operation = Operation_t None
-
- let bool = Bool_t None
-
- let mutez = Mutez_t None
-
- let string = String_t None
- let string_k = String_key None
- let address_k = Address_key None
-
- let key = Key_t None
-
- let list a = List_t (a, None)
- let set a = Set_t (a, None)
- let assert_list = function
- | List_t (a, _) -> a
- | _ -> assert false
-
- let option a = Option_t ((a, None), None, None)
- let contract a = Contract_t (a, None)
- let assert_option = function
- | Option_t ((a, _), _, _) -> a
- | _ -> assert false
-
- let address = Address_t None
-
- let lambda a b = Lambda_t (a, b, None)
- let assert_lambda = function
- | Lambda_t (a, b, _) -> (a, b)
- | _ -> assert false
- type ex_lambda = Ex_lambda : (_, _) lambda ty -> ex_lambda
- let is_lambda : type a . a ty -> ex_lambda option = function
- | Lambda_t (_, _, _) as x -> Some (Ex_lambda x)
- | _ -> None
-
- let timestamp = Timestamp_t None
- let timestamp_k = Timestamp_key None
-
- let map a b = Map_t (a, b, None)
-
- let assert_type (_:'a ty) (_:'a) = ()
-end
-
-module Values = struct
- let empty_map t = empty_map t
-
- let empty_big_map key_type comparable_key_ty value_type : ('a, 'b) big_map = {
- key_type ; value_type ; diff = empty_map comparable_key_ty ;
- }
-
- let int n = Script_int.of_int n
-
- let nat n = Script_int.abs @@ Script_int.of_int n
- let nat_to_int n = Option.unopt_exn @@ Script_int.to_int n
-
- let tez n = Option.unopt_exn @@ Tez.of_mutez @@ Int64.of_int n
-
- let left a = L a
-
- let right b = R b
-end
diff --git a/src/meta_michelson/dune b/src/meta_michelson/dune
deleted file mode 100644
index 2ba2a8ae8..000000000
--- a/src/meta_michelson/dune
+++ /dev/null
@@ -1,11 +0,0 @@
-(library
- (name meta_michelson)
- (public_name ligo.meta_michelson)
- (libraries
- simple-utils
- tezos-utils
- proto-alpha-utils
- michelson-parser
- tezos-micheline
- )
-)
diff --git a/src/meta_michelson/json.ml b/src/meta_michelson/json.ml
deleted file mode 100644
index 9ed070d0c..000000000
--- a/src/meta_michelson/json.ml
+++ /dev/null
@@ -1,7 +0,0 @@
-let force_record ~msg json = match json with
- | `O json -> json
- | _ -> raise @@ Failure ("not json record : " ^ msg)
-
-let force_string ~msg json = match json with
- | `String str -> str
- | _ -> raise @@ Failure ("not json str : " ^ msg)
diff --git a/src/meta_michelson/meta_michelson.ml b/src/meta_michelson/meta_michelson.ml
deleted file mode 100644
index 7e80979ed..000000000
--- a/src/meta_michelson/meta_michelson.ml
+++ /dev/null
@@ -1,12 +0,0 @@
-module Run = struct
- open Contract
- let run_lwt_full = run_lwt_full
- let run_lwt = run_lwt
- let run_str = run_str
- let run_node = run_node
- let run = run
-end
-module Stack = Michelson_wrap.Stack
-module Values = Contract.Values
-module Types = Contract.Types
-
diff --git a/src/meta_michelson/michelson_wrap.ml b/src/meta_michelson/michelson_wrap.ml
deleted file mode 100644
index ae3034779..000000000
--- a/src/meta_michelson/michelson_wrap.ml
+++ /dev/null
@@ -1,514 +0,0 @@
-open Proto_alpha_utils.Memory_proto_alpha
-module AC = Alpha_context
-
-module Types = Contract.Types
-module Option = Simple_utils.Option
-module MBytes = Alpha_environment.MBytes
-
-module Stack = struct
- open Script_typed_ir
-
- let descr bef aft instr =
- {
- loc = 0 ;
- bef ; aft ; instr
- }
-
- type nonrec 'a ty = 'a ty
- type 'a t = 'a stack_ty
- type nonrec ('a, 'b) descr = ('a, 'b) descr
- type ('a, 'b) code = ('a t) -> ('a, 'b) descr
-
- type ex_stack_ty = Ex_stack_ty : 'a t -> ex_stack_ty
- type ex_descr = Ex_descr : ('a, 'b) descr -> ex_descr
- type ex_code = Ex_code : ('a, 'b) code -> ex_code
-
- let stack ?annot a b = Item_t (a, b, annot)
- let unstack (item: (('a * 'rest) stack_ty)) : ('a ty * 'rest stack_ty) =
- let Item_t (hd, tl, _) = item in
- (hd, tl)
-
- let nil = Empty_t
- let head x = fst @@ unstack x
- let tail x = snd @@ unstack x
-
- let seq a b bef =
- let a_descr = a bef in
- let b_descr = b a_descr.aft in
- let aft = b_descr.aft in
- descr bef aft @@ Seq (a_descr, b_descr)
-
- let (@>) (stack : 'b t) (code : ('a, 'b) code) = code stack
- let (@|) = seq
- let (@:) = stack
-
- let (!:) : ('a, 'b) descr -> ('a, 'b) code = fun d _ -> d
-
- let (<.) (stack:'a t) (code: ('a, 'b) code): ('a, 'b) descr = code stack
-
- let (<::) : ('a, 'b) descr -> ('b, 'c) descr -> ('a, 'c) descr = fun ab bc ->
- descr ab.bef bc.aft @@ Seq(ab, bc)
-
- let (<:) (ab_descr:('a, 'b) descr) (code:('b, 'c) code) : ('a, 'c) descr =
- let bc_descr = code ab_descr.aft in
- ab_descr <:: bc_descr
-
-end
-
-open Stack
-
-type nat = AC.Script_int.n AC.Script_int.num
-type int_num = AC.Script_int.z AC.Script_int.num
-type bytes = MBytes.t
-type address = AC.Contract.t Script_typed_ir.ty
-type mutez = AC.Tez.t Script_typed_ir.ty
-
-
-module Stack_ops = struct
- open Script_typed_ir
- let dup : ('a * 'rest, 'a * ('a * 'rest)) code = fun bef ->
- let Item_t (ty, rest, _) = bef in
- descr bef (Item_t (ty, Item_t (ty, rest, None), None)) Dup
-
- let drop : ('a * 'rest, 'rest) code = fun bef ->
- let aft = snd @@ unstack bef in
- descr bef aft Drop
-
- let swap (bef : (('a * ('b * 'c)) stack_ty)) =
- let Item_t (a, Item_t (b, rest, _), _) = bef in
- descr bef (Item_t (b, (Item_t (a, rest, None)), None)) Swap
-
- let dip code (bef : ('ty * 'rest) stack_ty) =
- let Item_t (ty, rest, _) = bef in
- let applied = code rest in
- let aft = Item_t (ty, applied.aft, None) in
- descr bef aft (Dip (code rest))
-
- let noop : ('r, 'r) code = fun bef ->
- descr bef bef Nop
-
- let exec : (_, _) code = fun bef ->
- let lambda = head @@ tail bef in
- let (_, ret) = Types.assert_lambda lambda in
- let aft = ret @: (tail @@ tail bef) in
- descr bef aft Exec
-
- let fail aft : ('a * 'r, 'b) code = fun bef ->
- let head = fst @@ unstack bef in
- descr bef aft (Failwith head)
-
- let push_string str (bef : 'rest stack_ty) : (_, (string * 'rest)) descr =
- let aft = Item_t (Types.string, bef, None) in
- descr bef aft (Const (str))
-
- let push_none (a:'a ty) : ('rest, 'a option * 'rest) code = fun r ->
- let aft = stack (Types.option a) r in
- descr r aft (Const None)
-
- let push_unit : ('rest, unit * 'rest) code = fun r ->
- let aft = stack Types.unit r in
- descr r aft (Const ())
-
- let push_nat n (bef : 'rest stack_ty) : (_, (nat * 'rest)) descr =
- let aft = Item_t (Types.nat, bef, None) in
- descr bef aft (Const (Contract.Values.nat n))
-
- let push_int n (bef : 'rest stack_ty) : (_, (int_num * 'rest)) descr =
- let aft = Types.int @: bef in
- descr bef aft (Const (Contract.Values.int n))
-
- let push_tez n (bef : 'rest stack_ty) : (_, (AC.Tez.tez * 'rest)) descr =
- let aft = Types.mutez @: bef in
- descr bef aft (Const (Contract.Values.tez n))
-
- let push_bool b : ('s, bool * 's) code = fun bef ->
- let aft = stack Types.bool bef in
- descr bef aft (Const b)
-
- let push_generic ty v : ('s, _ * 's) code = fun bef ->
- let aft = stack ty bef in
- descr bef aft (Const v)
-
- let failstring str aft =
- push_string str @| fail aft
-
-end
-
-module Stack_shortcuts = struct
- open Stack_ops
-
- let diip c x = dip (dip c) x
- let diiip c x = dip (diip c) x
- let diiiip c x = dip (diiip c) x
-
- let bubble_1 = swap
- let bubble_down_1 = swap
-
- let bubble_2 : ('a * ('b * ('c * 'r)), 'c * ('a * ('b * 'r))) code = fun bef ->
- bef <. dip swap <: swap
- let bubble_down_2 : ('a * ('b * ('c * 'r)), ('b * ('c * ('a * 'r)))) code = fun bef ->
- bef <. swap <: dip swap
-
- let bubble_3 : ('a * ('b * ('c * ('d * 'r))), 'd * ('a * ('b * ('c * 'r)))) code = fun bef ->
- bef <. diip swap <: dip swap <: swap
-
- let keep_1 : type r s . ('a * r, s) code -> ('a * r, 'a * s) code = fun code bef ->
- bef <. dup <: dip code
-
- let save_1_1 : type r . ('a * r, 'b * r) code -> ('a * r, 'b * ('a * r)) code = fun code s ->
- s <. keep_1 code <: swap
-
- let keep_2 : type r s . ('a * ('b * r), s) code -> ('a * ('b * r), ('a * ('b * s))) code = fun code bef ->
- (dup @| dip (swap @| dup @| dip (swap @| code))) bef
-
- let keep_2_1 : type r s . ('a * ('b * r), s) code -> ('a * ('b * r), 'b * s) code = fun code bef ->
- (dip dup @| swap @| dip code) bef
-
- let relativize_1_1 : ('a * unit, 'b * unit) descr -> ('a * 'r, 'b * 'r) code = fun d s ->
- let aft = head d.aft @: tail s in
- descr s aft d.instr
-
-end
-
-module Pair_ops = struct
- let car (bef : (('a * 'b) * 'rest) Stack.t) =
- let (pair, rest) = unstack bef in
- let (a, _) = Contract.Types.assert_pair pair in
- descr bef (stack a rest) Car
-
- let cdr (bef : (('a * 'b) * 'rest) Stack.t) =
- let (pair, rest) = unstack bef in
- let (_, b) = Contract.Types.assert_pair pair in
- descr bef (stack b rest) Cdr
-
- let pair (bef : ('a * ('b * 'rest)) Stack.t) =
- let (a, rest) = unstack bef in
- let (b, rest) = unstack rest in
- let aft = (Types.pair a b) @: rest in
- descr bef aft Cons_pair
-
- open Stack_ops
- let carcdr s = s <. car <: Stack_ops.dip cdr
-
- let cdrcar s = s <. cdr <: dip car
-
- let cdrcdr s = s <. cdr <: dip cdr
-
- let carcar s = s <. car <: dip car
-
- let cdar s = s <. cdr <: car
-
- let unpair s = s <. dup <: car <: dip cdr
-end
-
-module Option_ops = struct
- open Script_typed_ir
-
- let cons bef =
- let (hd, tl) = unstack bef in
- descr bef (stack (Contract.Types.option hd) tl) Cons_some
-
- let cond ?target none_branch some_branch : ('a option * 'r, 'b) code = fun bef ->
- let (a_opt, base) = unstack bef in
- let a = Types.assert_option a_opt in
- let target = Option.unopt ~default:(none_branch base).aft target in
- descr bef target (If_none (none_branch base, some_branch (stack a base)))
-
- let force_some ?msg : ('a option * 'r, 'a * 'r) code = fun s ->
- let (a_opt, base) = unstack s in
- let a = Types.assert_option a_opt in
- let target = a @: base in
- cond ~target
- (Stack_ops.failstring ("force_some : " ^ Option.unopt ~default:"" msg) target)
- Stack_ops.noop s
-end
-
-module Union_ops = struct
- open Script_typed_ir
-
- let left (b:'b ty) : ('a * 'r, ('a, 'b) union * 'r) code = fun bef ->
- let (a, base) = unstack bef in
- let aft = Types.union a b @: base in
- descr bef aft Left
-
- let right (a:'a ty) : ('b * 'r, ('a, 'b) union * 'r) code = fun bef ->
- let (b, base) = unstack bef in
- let aft = Types.union a b @: base in
- descr bef aft Right
-
-
- let loop ?after (code: ('a * 'r, ('a, 'b) union * 'r) code): (('a, 'b) union * 'r, 'b * 'r) code = fun bef ->
- let (union, base) = unstack bef in
- let (a, b) = Types.assert_union union in
- let code_stack = a @: base in
- let aft = Option.unopt ~default:(b @: base) after in
- descr bef aft (Loop_left (code code_stack))
-
-end
-
-module Arithmetic = struct
- let neq : (int_num * 'r, bool *'r) code = fun bef ->
- let aft = stack Types.bool @@ snd @@ unstack bef in
- descr bef aft Neq
-
- let neg : (int_num * 'r, int_num *'r) code = fun bef ->
- let aft = stack Types.int @@ snd @@ unstack bef in
- descr bef aft Neg_int
-
- let abs : (int_num * 'r, nat *'r) code = fun bef ->
- let aft = stack Types.nat @@ snd @@ unstack bef in
- descr bef aft Abs_int
-
- let int : (nat * 'r, int_num*'r) code = fun bef ->
- let aft = stack Types.int @@ snd @@ unstack bef in
- descr bef aft Int_nat
-
- let nat_opt : (int_num * 'r, nat option * 'r) code = fun bef ->
- let aft = stack Types.(option nat) @@ tail bef in
- descr bef aft Is_nat
-
- let nat_neq = fun s -> (int @| neq) s
-
- let add_natnat (bef : (nat * (nat * 'rest)) Stack.t) =
- let (nat, rest) = unstack bef in
- let rest = tail rest in
- let aft = stack nat rest in
- descr bef aft Add_natnat
-
- let add_intint (bef : (int_num * (int_num * 'rest)) Stack.t) =
- let (nat, rest) = unstack bef in
- let rest = tail rest in
- let aft = stack nat rest in
- descr bef aft Add_intint
-
- let add_teztez : (AC.Tez.tez * (AC.Tez.tez * 'rest), _) code = fun bef ->
- let aft = tail bef in
- descr bef aft Add_tez
-
- let mul_natnat (bef : (nat * (nat * 'rest)) Stack.t) =
- let nat = head bef in
- let rest = tail @@ tail bef in
- let aft = stack nat rest in
- descr bef aft Mul_natnat
-
- let mul_intint (bef : (int_num * (int_num * 'rest)) Stack.t) =
- let nat = head bef in
- let rest = tail @@ tail bef in
- let aft = stack nat rest in
- descr bef aft Mul_intint
-
- let sub_intint : (int_num * (int_num * 'r), int_num * 'r) code = fun bef ->
- let aft = tail bef in
- descr bef aft Sub_int
-
- let sub_natnat : (nat * (nat * 'r), int_num * 'r) code =
- fun bef -> bef <. int <: Stack_ops.dip int <: sub_intint
-
- let ediv : (nat * (nat * 'r), (nat * nat) option * 'r) code = fun s ->
- let (n, base) = unstack @@ snd @@ unstack s in
- let aft = Types.option (Types.pair n n) @: base in
- descr s aft Ediv_natnat
-
- let ediv_tez = fun s ->
- let aft = Types.(option @@ pair (head s) (head s)) @: tail @@ tail s in
- descr s aft Ediv_teznat
-
- open Option_ops
- let force_ediv x = x <. ediv <: force_some
- let force_ediv_tez x = (ediv_tez @| force_some) x
-
- open Pair_ops
- let div x = x <. force_ediv <: car
-
- open Stack_ops
- let div_n n s = s <. push_nat n <: swap <: div
- let add_n n s = s <. push_nat n <: swap <: add_natnat
- let add_teztez_n n s = s <. push_tez n <: swap <: add_teztez
- let sub_n n s = s <. push_nat n <: swap <: sub_natnat
-
- let force_nat s = s <. nat_opt <: force_some ~msg:"force nat"
-end
-
-module Boolean = struct
- let bool_and (type r) : (bool * (bool * r), bool * r) code = fun bef ->
- let aft = Types.bool @: tail @@ tail bef in
- descr bef aft And
-
- let bool_or (type r) : (bool * (bool * r), bool * r) code = fun bef ->
- let aft = Types.bool @: tail @@ tail bef in
- descr bef aft Or
-
- open Script_typed_ir
- let cond ?target true_branch false_branch : (bool * 'r, 's) code = fun bef ->
- let base = tail bef in
- let aft = Option.unopt ~default:((true_branch base).aft) target in
- descr bef aft (If (true_branch base, false_branch base))
-
- let loop (code : ('s, bool * 's) code) : ((bool * 's), 's) code = fun bef ->
- let aft = tail bef in
- descr bef aft @@ Loop (code aft)
-
-end
-
-module Comparison_ops = struct
- let cmp c_ty : _ code = fun bef ->
- let aft = stack Contract.Types.int @@ tail @@ tail @@ bef in
- descr bef aft (Compare c_ty)
-
- let cmp_bytes = fun x -> cmp (Bytes_key None) x
-
- let eq : (int_num * 'r, bool *'r) code = fun bef ->
- let aft = stack Contract.Types.bool @@ snd @@ unstack bef in
- descr bef aft Eq
-
- open Arithmetic
- let eq_n n s = s <. sub_n n <: eq
-
- let ge : (int_num * 'r, bool * 'r) code = fun bef ->
- let base = tail bef in
- let aft = stack Types.bool base in
- descr bef aft Ge
-
- let gt : (int_num * 'r, bool * 'r) code = fun bef ->
- let base = tail bef in
- let aft = stack Types.bool base in
- descr bef aft Gt
-
- let lt : (int_num * 'r, bool * 'r) code = fun bef ->
- let base = tail bef in
- let aft = stack Types.bool base in
- descr bef aft Lt
-
- let gt_nat s = s <. int <: gt
-
- open Stack_ops
- let assert_positive_nat s = s <. dup <: gt_nat <: Boolean.cond noop (failstring "positive" s)
-
- let cmp_ge_nat : (nat * (nat * 'r), bool * 'r) code = fun bef ->
- bef <. sub_natnat <: ge
-
- let cmp_ge_timestamp : (AC.Script_timestamp.t * (AC.Script_timestamp.t * 'r), bool * 'r) code = fun bef ->
- bef <. cmp Types.timestamp_k <: ge
-
- let assert_cmp_ge_nat : (nat * (nat * 'r), 'r) code = fun bef ->
- bef <. cmp_ge_nat <: Boolean.cond noop (failstring "assert cmp ge nat" (tail @@ tail bef))
-
- let assert_cmp_ge_timestamp : (AC.Script_timestamp.t * (AC.Script_timestamp.t * 'r), 'r) code = fun bef ->
- bef <. cmp_ge_timestamp <: Boolean.cond noop (failstring "assert cmp ge timestamp" (tail @@ tail bef))
-end
-
-
-module Bytes = struct
-
- open Script_typed_ir
-
- let pack (ty:'a ty) : ('a * 'r, bytes * 'r) code = fun bef ->
- let aft = stack Types.bytes @@ tail bef in
- descr bef aft (Pack ty)
-
- let unpack_opt : type a . a ty -> (bytes * 'r, a option * 'r) code = fun ty bef ->
- let aft = stack (Types.option ty) (tail bef) in
- descr bef aft (Unpack ty)
-
- let unpack ty s = s <. unpack_opt ty <: Option_ops.force_some
-
- let concat : (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) code = fun bef ->
- let aft = tail bef in
- descr bef aft Concat_bytes_pair
-
- let sha256 : (MBytes.t * 'rest, MBytes.t * 'rest) code = fun bef ->
- descr bef bef Sha256
-
- let blake2b : (MBytes.t * 'rest, MBytes.t * 'rest) code = fun bef ->
- descr bef bef Blake2b
-end
-
-
-module Map = struct
- open Script_typed_ir
-
- type ('a, 'b) t = ('a, 'b) map
-
- let empty c_ty = Script_ir_translator.empty_map c_ty
- let set (type a b) m (k:a) (v:b) = Script_ir_translator.map_update k (Some v) m
-
- module Ops = struct
- let update (bef : (('a * ('b option * (('a, 'b) map * ('rest)))) Stack.t)) : (_, ('a, 'b) map * 'rest) descr =
- let Item_t (_, Item_t (_, Item_t (map, rest, _), _), _) = bef in
- let aft = Item_t (map, rest, None) in
- descr bef aft Map_update
-
- let get : ?a:('a ty) -> 'b ty -> ('a * (('a, 'b) map * 'r), 'b option * 'r) code = fun ?a b bef ->
- let _ = a in
- let base = snd @@ unstack @@ snd @@ unstack bef in
- let aft = stack (Types.option b) base in
- descr bef aft Map_get
-
- let big_get : 'a ty -> 'b ty -> ('a * (('a, 'b) big_map * 'r), 'b option * 'r) code = fun _a b bef ->
- let base = snd @@ unstack @@ snd @@ unstack bef in
- let aft = stack (Types.option b) base in
- descr bef aft Big_map_get
-
- let big_update : ('a * ('b option * (('a, 'b) big_map * 'r)), ('a, 'b) big_map * 'r) code = fun bef ->
- let base = tail @@ tail bef in
- descr bef base Big_map_update
- end
-end
-
-module List_ops = struct
- let nil ele bef =
- let aft = stack (Types.list ele) bef in
- descr bef aft Nil
-
- let cons bef =
- let aft = tail bef in
- descr bef aft Cons_list
-
- let cond ~target cons_branch nil_branch bef =
- let (lst, aft) = unstack bef in
- let a = Types.assert_list lst in
- let cons_descr = cons_branch (a @: Types.list a @: aft) in
- let nil_descr = nil_branch aft in
- descr bef target (If_cons (cons_descr, nil_descr))
-
- let list_iter : type a r . (a * r, r) code -> (a list * r, r) code = fun code bef ->
- let (a_lst, aft) = unstack bef in
- let a = Types.assert_list a_lst in
- descr bef aft (List_iter (code (a @: aft)))
-
-end
-
-module Tez = struct
-
- let amount : ('r, AC.Tez.t * 'r) code = fun bef ->
- let aft = Types.mutez @: bef in
- descr bef aft Amount
-
- open Bytes
-
- let tez_nat s = s <. pack Types.mutez <: unpack Types.nat
- let amount_nat s = s <. amount <: pack Types.mutez <: unpack Types.nat
-end
-
-module Misc = struct
-
- open Stack_ops
- open Stack_shortcuts
- open Comparison_ops
- let min_nat : (nat * (nat * 'r), nat * 'r) code = fun s ->
- s <.
- keep_2 cmp_ge_nat <: bubble_2 <:
- Boolean.cond drop (dip drop)
-
- let debug ~msg () s = s <. push_string msg <: push_string "_debug" <: noop <: drop <: drop
-
- let debug_msg msg = debug ~msg ()
-
- let now : ('r, AC.Script_timestamp.t * 'r) code = fun bef ->
- let aft = stack Types.timestamp bef in
- descr bef aft Now
-
-end
-
-
-
diff --git a/src/meta_michelson/misc.ml b/src/meta_michelson/misc.ml
deleted file mode 100644
index af5385c14..000000000
--- a/src/meta_michelson/misc.ml
+++ /dev/null
@@ -1,302 +0,0 @@
-module Signature = Tezos_base.TzPervasives.Signature
-open Proto_alpha_utils.Memory_proto_alpha
-module Data_encoding = Alpha_environment.Data_encoding
-module MBytes = Alpha_environment.MBytes
-module Error_monad = Proto_alpha_utils.Error_monad
-open Error_monad
-
-module Context_init = struct
-
- type account = {
- pkh : Signature.Public_key_hash.t ;
- pk : Signature.Public_key.t ;
- sk : Signature.Secret_key.t ;
- }
-
- let generate_accounts n : (account * Tez_repr.t) list =
- let amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in
- List.map (fun _ ->
- let (pkh, pk, sk) = Signature.generate_key () in
- let account = { pkh ; pk ; sk } in
- account, amount)
- (Simple_utils.List.range n)
-
- let make_shell
- ~level ~predecessor ~timestamp ~fitness ~operations_hash =
- Tezos_base.Block_header.{
- level ;
- predecessor ;
- timestamp ;
- fitness ;
- operations_hash ;
- (* We don't care of the following values, only the shell validates them. *)
- proto_level = 0 ;
- validation_passes = 0 ;
- context = Alpha_environment.Context_hash.zero ;
- }
-
- let default_proof_of_work_nonce =
- MBytes.create Alpha_context.Constants.proof_of_work_nonce_size
-
- let protocol_param_key = [ "protocol_parameters" ]
-
- let check_constants_consistency constants =
- let open Constants_repr in
- let open Error_monad in
- let { blocks_per_cycle ; blocks_per_commitment ;
- blocks_per_roll_snapshot ; _ } = constants in
- Error_monad.unless (blocks_per_commitment <= blocks_per_cycle)
- (fun () -> failwith "Inconsistent constants : blocks per commitment must be \
- less than blocks per cycle") >>=? fun () ->
- Error_monad.unless (blocks_per_cycle >= blocks_per_roll_snapshot)
- (fun () -> failwith "Inconsistent constants : blocks per cycle \
- must be superior than blocks per roll snapshot") >>=?
- return
-
-
- let initial_context
- constants
- header
- commitments
- initial_accounts
- security_deposit_ramp_up_cycles
- no_reward_cycles
- =
- let open Tezos_base.TzPervasives.Error_monad in
- let bootstrap_accounts =
- List.map (fun ({ pk ; pkh ; _ }, amount) ->
- let open! Parameters_repr in
- { public_key_hash = pkh ; public_key = Some pk ; amount }
- ) initial_accounts
- in
- let json =
- Data_encoding.Json.construct
- Parameters_repr.encoding
- Parameters_repr.{
- bootstrap_accounts ;
- bootstrap_contracts = [] ;
- commitments ;
- constants ;
- security_deposit_ramp_up_cycles ;
- no_reward_cycles ;
- }
- in
- let proto_params =
- Data_encoding.Binary.to_bytes_exn Data_encoding.json json
- in
- Tezos_protocol_environment_memory.Context.(
- set empty ["version"] (MBytes.of_string "genesis")
- ) >>= fun ctxt ->
- Tezos_protocol_environment_memory.Context.(
- set ctxt protocol_param_key proto_params
- ) >>= fun ctxt ->
- Main.init ctxt header
- >|= Alpha_environment.wrap_error >>=? fun { context; _ } ->
- return context
-
- let genesis
- ?(preserved_cycles = Constants_repr.default.preserved_cycles)
- ?(blocks_per_cycle = Constants_repr.default.blocks_per_cycle)
- ?(blocks_per_commitment = Constants_repr.default.blocks_per_commitment)
- ?(blocks_per_roll_snapshot = Constants_repr.default.blocks_per_roll_snapshot)
- ?(blocks_per_voting_period = Constants_repr.default.blocks_per_voting_period)
- ?(time_between_blocks = Constants_repr.default.time_between_blocks)
- ?(endorsers_per_block = Constants_repr.default.endorsers_per_block)
- ?(hard_gas_limit_per_operation = Constants_repr.default.hard_gas_limit_per_operation)
- ?(hard_gas_limit_per_block = Constants_repr.default.hard_gas_limit_per_block)
- ?(proof_of_work_threshold = Int64.(neg one))
- ?(tokens_per_roll = Constants_repr.default.tokens_per_roll)
- ?(michelson_maximum_type_size = Constants_repr.default.michelson_maximum_type_size)
- ?(seed_nonce_revelation_tip = Constants_repr.default.seed_nonce_revelation_tip)
- ?(origination_size = Constants_repr.default.origination_size)
- ?(block_security_deposit = Constants_repr.default.block_security_deposit)
- ?(endorsement_security_deposit = Constants_repr.default.endorsement_security_deposit)
- ?(block_reward = Constants_repr.default.block_reward)
- ?(endorsement_reward = Constants_repr.default.endorsement_reward)
- ?(cost_per_byte = Constants_repr.default.cost_per_byte)
- ?(hard_storage_limit_per_operation = Constants_repr.default.hard_storage_limit_per_operation)
- ?(commitments = [])
- ?(security_deposit_ramp_up_cycles = None)
- ?(no_reward_cycles = None)
- (initial_accounts : (account * Tez_repr.t) list)
- =
- if initial_accounts = [] then
- Pervasives.failwith "Must have one account with a roll to bake";
-
- (* Check there is at least one roll *)
- let open Tezos_base.TzPervasives.Error_monad in
- begin try
- let (>>?=) x y = match x with
- | Ok(a) -> y a
- | Error(b) -> fail @@ List.hd b in
- fold_left_s (fun acc (_, amount) ->
- Alpha_environment.wrap_error @@
- Tez_repr.(+?) acc amount >>?= fun acc ->
- if acc >= tokens_per_roll then
- raise Exit
- else return acc
- ) Tez_repr.zero initial_accounts >>=? fun _ ->
- failwith "Insufficient tokens in initial accounts to create one roll"
- with Exit -> return ()
- end >>=? fun () ->
-
- let constants : Constants_repr.parametric = {
- preserved_cycles ;
- blocks_per_cycle ;
- blocks_per_commitment ;
- blocks_per_roll_snapshot ;
- blocks_per_voting_period ;
- time_between_blocks ;
- endorsers_per_block ;
- hard_gas_limit_per_operation ;
- hard_gas_limit_per_block ;
- proof_of_work_threshold ;
- tokens_per_roll ;
- michelson_maximum_type_size ;
- seed_nonce_revelation_tip ;
- origination_size ;
- block_security_deposit ;
- endorsement_security_deposit ;
- block_reward ;
- endorsement_reward ;
- cost_per_byte ;
- hard_storage_limit_per_operation ;
- } in
- check_constants_consistency constants >>=? fun () ->
-
- let hash =
- Alpha_environment.Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU"
- in
- let shell = make_shell
- ~level:0l
- ~predecessor:hash
- ~timestamp:Tezos_utils.Time.epoch
- ~fitness: (Fitness_repr.from_int64 0L)
- ~operations_hash: Alpha_environment.Operation_list_list_hash.zero in
- initial_context
- constants
- shell
- commitments
- initial_accounts
- security_deposit_ramp_up_cycles
- no_reward_cycles
- >>=? fun context ->
- return (context, shell, hash)
-
- let init
- ?(slow=false)
- ?preserved_cycles
- ?endorsers_per_block
- ?commitments
- n =
- let open Error_monad in
- let accounts = generate_accounts n in
- let contracts = List.map (fun (a, _) ->
- Alpha_context.Contract.implicit_contract (a.pkh)) accounts in
- begin
- if slow then
- genesis
- ?preserved_cycles
- ?endorsers_per_block
- ?commitments
- accounts
- else
- genesis
- ?preserved_cycles
- ~blocks_per_cycle:32l
- ~blocks_per_commitment:4l
- ~blocks_per_roll_snapshot:8l
- ~blocks_per_voting_period:(Int32.mul 32l 8l)
- ?endorsers_per_block
- ?commitments
- accounts
- end >>=? fun ctxt ->
- return (ctxt, accounts, contracts)
-
- let contents
- ?(proof_of_work_nonce = default_proof_of_work_nonce)
- ?(priority = 0) ?seed_nonce_hash () =
- Alpha_context.Block_header.({
- priority ;
- proof_of_work_nonce ;
- seed_nonce_hash ;
- })
-
-
- let begin_construction ?(priority=0) ~timestamp ~(header:Alpha_context.Block_header.shell_header) ~hash ctxt =
- let contents = contents ~priority () in
- let protocol_data =
- let open! Alpha_context.Block_header in {
- contents ;
- signature = Signature.zero ;
- } in
- let header = {
- Alpha_context.Block_header.shell = {
- predecessor = hash ;
- proto_level = header.proto_level ;
- validation_passes = header.validation_passes ;
- fitness = header.fitness ;
- timestamp ;
- level = header.level ;
- context = Alpha_environment.Context_hash.zero ;
- operations_hash = Alpha_environment.Operation_list_list_hash.zero ;
- } ;
- protocol_data = {
- contents ;
- signature = Signature.zero ;
- } ;
- } in
- Main.begin_construction
- ~chain_id: Alpha_environment.Chain_id.zero
- ~predecessor_context: ctxt
- ~predecessor_timestamp: header.shell.timestamp
- ~predecessor_fitness: header.shell.fitness
- ~predecessor_level: header.shell.level
- ~predecessor:hash
- ~timestamp
- ~protocol_data
- () >>= fun x -> Lwt.return @@ Alpha_environment.wrap_error x >>=? fun state ->
- return state.ctxt
-
- let main n =
- init n >>=? fun ((ctxt, header, hash), accounts, contracts) ->
- let timestamp = Tezos_base.Time.now () in
- begin_construction ~timestamp ~header ~hash ctxt >>=? fun ctxt ->
- return (ctxt, accounts, contracts)
-
-end
-
-type identity = {
- public_key_hash : Signature.public_key_hash;
- public_key : Signature.public_key;
- secret_key : Signature.secret_key;
- implicit_contract : Alpha_context.Contract.t;
-}
-
-type environment = {
- tezos_context : Alpha_context.t ;
- identities : identity list ;
-}
-
-let init_environment () =
- Context_init.main 10 >>=? fun (tezos_context, accounts, contracts) ->
- let accounts = List.map fst accounts in
- let tezos_context = Alpha_context.Gas.set_limit tezos_context @@ Z.of_int 350000 in
- let identities =
- List.map (fun ((a:Context_init.account), c) -> {
- public_key = a.pk ;
- public_key_hash = a.pkh ;
- secret_key = a.sk ;
- implicit_contract = c ;
- }) @@
- List.combine accounts contracts in
- return {tezos_context ; identities}
-
-let contextualize ~msg ?environment f =
- let lwt =
- let environment = match environment with
- | None -> init_environment ()
- | Some x -> return x in
- environment >>=? f
- in
- force_ok ~msg @@ Lwt_main.run lwt
diff --git a/src/meta_michelson/streams.ml b/src/meta_michelson/streams.ml
deleted file mode 100644
index b45176516..000000000
--- a/src/meta_michelson/streams.ml
+++ /dev/null
@@ -1,18 +0,0 @@
-let read_file f =
- let ic = open_in f in
- let n = in_channel_length ic in
- let s = Bytes.create n in
- really_input ic s 0 n;
- close_in ic;
- Bytes.to_string s
-
-let read_lines filename =
- let lines = ref [] in
- let chan = open_in filename in
- try
- while true; do
- lines := input_line chan :: !lines
- done; !lines
- with End_of_file ->
- close_in chan;
- List.rev !lines
diff --git a/src/mini_c/dune b/src/mini_c/dune
index 059ce005f..d7e69d219 100644
--- a/src/mini_c/dune
+++ b/src/mini_c/dune
@@ -4,10 +4,9 @@
(libraries
simple-utils
tezos-utils
- meta_michelson
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
)
diff --git a/src/mini_c/types.ml b/src/mini_c/types.ml
index 3e9a69819..0bc00441c 100644
--- a/src/mini_c/types.ml
+++ b/src/mini_c/types.ml
@@ -51,7 +51,7 @@ type value =
| D_set of value list
(* | `Macro of anon_macro ... The future. *)
| D_function of anon_function
- | D_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
+ | D_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
and selector = var_name list
diff --git a/src/operators/dune b/src/operators/dune
index f19047fd0..0bd5db43d 100644
--- a/src/operators/dune
+++ b/src/operators/dune
@@ -8,7 +8,7 @@
mini_c
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -open Simple_utils ))
)
diff --git a/src/parser/camligo/dune b/src/parser/camligo/dune
index 62e28bcb6..428f10424 100644
--- a/src/parser/camligo/dune
+++ b/src/parser/camligo/dune
@@ -10,7 +10,7 @@
(flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils -open Tezos_utils ))
(preprocess
(pps
- simple-utils.ppx_let_generalized
+ ppx_let
ppx_deriving.std
)
)
diff --git a/src/parser/dune b/src/parser/dune
index 9fa014ac7..da0988ab2 100644
--- a/src/parser/dune
+++ b/src/parser/dune
@@ -10,7 +10,7 @@
parser_ligodity
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared ))
)
diff --git a/src/parser/pascaligo/.gitlab-ci.yml b/src/parser/pascaligo/.gitlab-ci.yml
deleted file mode 100644
index a64366465..000000000
--- a/src/parser/pascaligo/.gitlab-ci.yml
+++ /dev/null
@@ -1,21 +0,0 @@
-before_script:
- - apt-get update -qq
- - apt-get -y -qq install libhidapi-dev libcap-dev bubblewrap
- - wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O opam-2.0.1-x86_64-linux
- - cp opam-2.0.1-x86_64-linux /usr/local/bin/opam
- - chmod +x /usr/local/bin/opam
- - export PATH="/usr/local/bin${PATH:+:}${PATH:-}"
- - echo "$PATH"
- - printf '' | opam init
- - eval $(opam config env)
- - opam repository add tezos-opam-repository https://gitlab.com/ligolang/tezos-opam-repository.git
- - eval $(opam config env)
- - opam --version
- - printf '' | ocaml
-
-default-job:
- script:
- - opam install -y --working-dir .
- artifacts:
- paths:
- - Parser.exe
diff --git a/src/simplify/dune b/src/simplify/dune
index 5e4e7d88b..9649d13dc 100644
--- a/src/simplify/dune
+++ b/src/simplify/dune
@@ -10,7 +10,7 @@
(modules ligodity pascaligo simplify)
(preprocess
(pps
- simple-utils.ppx_let_generalized
+ ppx_let
)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml
index 0db0e53f8..1931b9857 100644
--- a/src/test/coase_tests.ml
+++ b/src/test/coase_tests.ml
@@ -75,13 +75,13 @@ let (first_owner , first_contract) =
let open Proto_alpha_utils.Memory_proto_alpha in
let id = List.nth dummy_environment.identities 0 in
let kt = id.implicit_contract in
- Alpha_context.Contract.to_b58check kt , kt
+ Protocol.Alpha_context.Contract.to_b58check kt , kt
let second_owner =
let open Proto_alpha_utils.Memory_proto_alpha in
let id = List.nth dummy_environment.identities 1 in
let kt = id.implicit_contract in
- Alpha_context.Contract.to_b58check kt
+ Protocol.Alpha_context.Contract.to_b58check kt
let basic a b cards next_id =
let card_patterns = List.map card_pattern_ez [
@@ -113,13 +113,13 @@ let buy () =
let%bind () =
let%bind amount =
trace_option (simple_error "getting amount for run") @@
- Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
+ Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
expect_eq_n_pos_small ~options program "buy_single" make_input make_expected in
let%bind () =
let%bind amount =
trace_option (simple_error "getting amount for run") @@
- Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
+ Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
trace_strong (simple_error "could buy without money") @@
Assert.assert_fail
@@ -152,13 +152,13 @@ let dispatch_buy () =
let%bind () =
let%bind amount =
trace_option (simple_error "getting amount for run") @@
- Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
+ Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
expect_eq_n_pos_small ~options program "main" make_input make_expected in
let%bind () =
let%bind amount =
trace_option (simple_error "getting amount for run") @@
- Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
+ Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
trace_strong (simple_error "could buy without money") @@
Assert.assert_fail
@@ -190,7 +190,7 @@ let transfer () =
e_pair ops storage
in
let%bind () =
- let amount = Memory_proto_alpha.Alpha_context.Tez.zero in
+ let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
let payer = first_contract in
let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~payer () in
expect_eq_n_strict_pos_small ~options program "transfer_single" make_input make_expected in
@@ -220,7 +220,7 @@ let sell () =
Ast_simplified.Misc.assert_value_eq (expected_storage , storage)
in
let%bind () =
- let amount = Memory_proto_alpha.Alpha_context.Tez.zero in
+ let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
let payer = first_contract in
let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~payer () in
expect_n_strict_pos_small ~options program "sell_single" make_input make_expecter in
diff --git a/src/test/dune b/src/test/dune
index aebc6fad9..021ae172f 100644
--- a/src/test/dune
+++ b/src/test/dune
@@ -6,7 +6,7 @@
alcotest
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils ))
)
diff --git a/src/transpiler/dune b/src/transpiler/dune
index 02104ba12..3f483bda3 100644
--- a/src/transpiler/dune
+++ b/src/transpiler/dune
@@ -9,7 +9,7 @@
operators
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
)
diff --git a/src/typer/dune b/src/typer/dune
index d9e63bf4a..0ee58cc43 100644
--- a/src/typer/dune
+++ b/src/typer/dune
@@ -9,7 +9,7 @@
operators
)
(preprocess
- (pps simple-utils.ppx_let_generalized)
+ (pps ppx_let)
)
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
)
diff --git a/vendors/tezos-modded/src/lib_memory_protocol_alpha/dune b/vendors/ligo-utils/memory-proto-alpha/dune
similarity index 100%
rename from vendors/tezos-modded/src/lib_memory_protocol_alpha/dune
rename to vendors/ligo-utils/memory-proto-alpha/dune
diff --git a/vendors/ligo-utils/memory-proto-alpha/dune-project b/vendors/ligo-utils/memory-proto-alpha/dune-project
new file mode 100644
index 000000000..1cf86c9fe
--- /dev/null
+++ b/vendors/ligo-utils/memory-proto-alpha/dune-project
@@ -0,0 +1,2 @@
+(lang dune 1.11)
+(name tezos-memory-proto-alpha)
diff --git a/vendors/tezos-modded/src/lib_memory_protocol_alpha/memory_proto_alpha.ml b/vendors/ligo-utils/memory-proto-alpha/memory_proto_alpha.ml
similarity index 62%
rename from vendors/tezos-modded/src/lib_memory_protocol_alpha/memory_proto_alpha.ml
rename to vendors/ligo-utils/memory-proto-alpha/memory_proto_alpha.ml
index b830e7b7d..f55378cd9 100644
--- a/vendors/tezos-modded/src/lib_memory_protocol_alpha/memory_proto_alpha.ml
+++ b/vendors/ligo-utils/memory-proto-alpha/memory_proto_alpha.ml
@@ -1,8 +1,9 @@
module Name = struct let name = "alpha" end
-module Alpha_environment = Tezos_protocol_environment_memory.MakeV1(Name)()
+module Alpha_environment = Tezos_protocol_alpha.Protocol.Environment
+
type alpha_error = Alpha_environment.Error_monad.error
type 'a alpha_tzresult = 'a Alpha_environment.Error_monad.tzresult
module Alpha_error_monad = Alpha_environment.Error_monad
-module Proto = Tezos_protocol_alpha.Functor.Make(Alpha_environment)
+module Proto = Tezos_protocol_alpha
include Proto
diff --git a/vendors/tezos-modded/src/lib_memory_protocol_alpha/tezos-memory-proto-alpha.opam b/vendors/ligo-utils/memory-proto-alpha/tezos-memory-proto-alpha.opam
similarity index 100%
rename from vendors/tezos-modded/src/lib_memory_protocol_alpha/tezos-memory-proto-alpha.opam
rename to vendors/ligo-utils/memory-proto-alpha/tezos-memory-proto-alpha.opam
diff --git a/vendors/ligo-utils/proto-alpha-utils/cast.ml b/vendors/ligo-utils/proto-alpha-utils/cast.ml
index 8bb4f5eaf..cbf70180f 100644
--- a/vendors/ligo-utils/proto-alpha-utils/cast.ml
+++ b/vendors/ligo-utils/proto-alpha-utils/cast.ml
@@ -4,6 +4,7 @@ open Tezos_micheline
let env = Error_monad.force_lwt ~msg:"Cast:init environment" @@ Init_proto_alpha.init_environment ()
open Memory_proto_alpha
+open Protocol
open Alpha_context
exception Expr_from_string
@@ -44,6 +45,196 @@ let node_to_string (node:_ Micheline.node) =
open Script_ir_translator
+type ex_typed_value =
+ Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
+
+include struct
+ open Script_typed_ir
+ open Protocol.Environment.Error_monad
+ module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse
+ open Micheline
+ open Michelson_v1_primitives
+ open Protocol.Environment
+
+ let rec unparse_data_generic
+ : type a. context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t) ->
+ unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
+ = fun ctxt ?(mapper = fun _ -> return None) mode ty a ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
+ mapper (Ex_typed_value (ty, a)) >>=? function
+ | Some x -> return (x, ctxt)
+ | None -> (
+ match ty, a with
+ | Unit_t _, () ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->
+ return (Prim (-1, D_Unit, [], []), ctxt)
+ | Int_t _, v ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+ return (Int (-1, Script_int.to_zint v), ctxt)
+ | Nat_t _, v ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+ return (Int (-1, Script_int.to_zint v), ctxt)
+ | String_t _, s ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->
+ return (String (-1, s), ctxt)
+ | Bytes_t _, s ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->
+ return (Bytes (-1, s), ctxt)
+ | Bool_t _, true ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+ return (Prim (-1, D_True, [], []), ctxt)
+ | Bool_t _, false ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+ return (Prim (-1, D_False, [], []), ctxt)
+ | Timestamp_t _, t ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+ | Readable ->
+ match Script_timestamp.to_notation t with
+ | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+ | Some s -> return (String (-1, s), ctxt)
+ end
+ | Address_t _, c ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+ end
+ | Contract_t _, (_, c) ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+ end
+ | Signature_t _, s ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable ->
+ return (String (-1, Signature.to_b58check s), ctxt)
+ end
+ | Mutez_t _, v ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->
+ return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
+ | Key_t _, k ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable ->
+ return (String (-1, Signature.Public_key.to_b58check k), ctxt)
+ end
+ | Key_hash_t _, k ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable ->
+ return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
+ end
+ | Operation_t _, op ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Alpha_context.Operation.internal_operation_encoding op in
+ Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
+ return (Bytes (-1, bytes), ctxt)
+ | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+ unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+ return (Prim (-1, D_Pair, [ l; r ], []), ctxt)
+ | Union_t ((tl, _), _, _), L l ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+ return (Prim (-1, D_Left, [ l ], []), ctxt)
+ | Union_t (_, (tr, _), _), R r ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+ return (Prim (-1, D_Right, [ r ], []), ctxt)
+ | Option_t ((t, _), _, _), Some v ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode t v >>=? fun (v, ctxt) ->
+ return (Prim (-1, D_Some, [ v ], []), ctxt)
+ | Option_t _, None ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->
+ return (Prim (-1, D_None, [], []), ctxt)
+ | List_t (t, _), items ->
+ fold_left_s
+ (fun (l, ctxt) element ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode t element >>=? fun (unparsed, ctxt) ->
+ return (unparsed :: l, ctxt))
+ ([], ctxt)
+ items >>=? fun (items, ctxt) ->
+ return (Micheline.Seq (-1, List.rev items), ctxt)
+ | Set_t (t, _), set ->
+ let t = ty_of_comparable_ty t in
+ fold_left_s
+ (fun (l, ctxt) item ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode t item >>=? fun (item, ctxt) ->
+ return (item :: l, ctxt))
+ ([], ctxt)
+ (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->
+ return (Micheline.Seq (-1, items), ctxt)
+ | Map_t (kt, vt, _), map ->
+ let kt = ty_of_comparable_ty kt in
+ fold_left_s
+ (fun (l, ctxt) (k, v) ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode kt k >>=? fun (key, ctxt) ->
+ unparse_data_generic ~mapper ctxt mode vt v >>=? fun (value, ctxt) ->
+ return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
+ ([], ctxt)
+ (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->
+ return (Micheline.Seq (-1, items), ctxt)
+ | Big_map_t (_kt, _kv, _), _map ->
+ return (Micheline.Seq (-1, []), ctxt)
+ | Lambda_t _, Lam (_, original_code) ->
+ unparse_code_generic ~mapper ctxt mode (root original_code)
+ )
+
+ and unparse_code_generic ctxt ?mapper mode = function
+ | Prim (loc, I_PUSH, [ ty ; data ], annot) ->
+ Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty) >>=? fun (Ex_ty t, ctxt) ->
+ parse_data ctxt t data >>=? fun (data, ctxt) ->
+ unparse_data_generic ?mapper ctxt mode t data >>=? fun (data, ctxt) ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)) >>=? fun ctxt ->
+ return (Prim (loc, I_PUSH, [ ty ; data ], annot), ctxt)
+ | Seq (loc, items) ->
+ fold_left_s
+ (fun (l, ctxt) item ->
+ unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+ return (item :: l, ctxt))
+ ([], ctxt) items >>=? fun (items, ctxt) ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))) >>=? fun ctxt ->
+ return (Micheline.Seq (loc, List.rev items), ctxt)
+ | Prim (loc, prim, items, annot) ->
+ fold_left_s
+ (fun (l, ctxt) item ->
+ unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+ return (item :: l, ctxt))
+ ([], ctxt) items >>=? fun (items, ctxt) ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)) >>=? fun ctxt ->
+ return (Prim (loc, prim, List.rev items, annot), ctxt)
+ | Int _ | String _ | Bytes _ as atom -> return (atom, ctxt)
+
+
+end
+
let rec mapper (Ex_typed_value (ty, a)) =
let open Alpha_environment.Error_monad in
let open Script_typed_ir in
@@ -67,7 +258,7 @@ let rec mapper (Ex_typed_value (ty, a)) =
and data_to_node (Ex_typed_value (ty, data)) =
let tc = env.tezos_context in
- let node_lwt = Script_ir_translator.unparse_data tc ~mapper Readable ty data in
+ let node_lwt = unparse_data_generic tc ~mapper Readable ty data in
let node = fst @@ Error_monad.force_lwt_alpha ~msg:"data to string" node_lwt in
node
@@ -125,7 +316,7 @@ let descr_to_node x =
| Car -> prim I_CAR
| Cdr -> prim I_CDR
| Cons_pair -> prim I_PAIR
- | Nop -> prim I_NOP
+ | Nop -> Micheline.Seq (0, [prim I_UNIT ; prim I_DROP])
| Seq (a, b) -> Micheline.Seq (0, List.map f [Ex_descr a ; Ex_descr b])
| Const v -> (
let (Item_t (ty, _, _)) = descr.aft in
diff --git a/vendors/ligo-utils/proto-alpha-utils/dune b/vendors/ligo-utils/proto-alpha-utils/dune
index 1db76360b..2b43cce9e 100644
--- a/vendors/ligo-utils/proto-alpha-utils/dune
+++ b/vendors/ligo-utils/proto-alpha-utils/dune
@@ -4,6 +4,7 @@
(libraries
tezos-error-monad
tezos-stdlib-unix
+ tezos-protocol-alpha-parameters
tezos-memory-proto-alpha
simple-utils
tezos-utils
diff --git a/vendors/ligo-utils/proto-alpha-utils/init_proto_alpha.ml b/vendors/ligo-utils/proto-alpha-utils/init_proto_alpha.ml
index 1ec930b5f..812d18b24 100644
--- a/vendors/ligo-utils/proto-alpha-utils/init_proto_alpha.ml
+++ b/vendors/ligo-utils/proto-alpha-utils/init_proto_alpha.ml
@@ -4,7 +4,7 @@ module Data_encoding = Alpha_environment.Data_encoding
module MBytes = Alpha_environment.MBytes
module Error_monad = X_error_monad
open Error_monad
-
+open Protocol
module Context_init = struct
@@ -85,10 +85,10 @@ module Context_init = struct
let proto_params =
Data_encoding.Binary.to_bytes_exn Data_encoding.json json
in
- Tezos_protocol_environment_memory.Context.(
- set empty ["version"] (MBytes.of_string "genesis")
+ Tezos_protocol_environment.Context.(
+ set Memory_context.empty ["version"] (MBytes.of_string "genesis")
) >>= fun ctxt ->
- Tezos_protocol_environment_memory.Context.(
+ Tezos_protocol_environment.Context.(
set ctxt protocol_param_key proto_params
) >>= fun ctxt ->
Main.init ctxt header
@@ -141,7 +141,7 @@ module Context_init = struct
with Exit -> return ()
end >>=? fun () ->
- let constants : Constants_repr.parametric = {
+ let constants : Constants_repr.parametric = Tezos_protocol_alpha_parameters.Default_parameters.({
preserved_cycles ;
blocks_per_cycle ;
blocks_per_commitment ;
@@ -162,7 +162,8 @@ module Context_init = struct
endorsement_reward ;
cost_per_byte ;
hard_storage_limit_per_operation ;
- } in
+ test_chain_duration = constants_mainnet.test_chain_duration ;
+ }) in
check_constants_consistency constants >>=? fun () ->
let hash =
@@ -171,7 +172,7 @@ module Context_init = struct
let shell = make_shell
~level:0l
~predecessor:hash
- ~timestamp:Tezos_base.TzPervasives.Time.epoch
+ ~timestamp:Tezos_base.TzPervasives.Time.Protocol.epoch
~fitness: (Fitness_repr.from_int64 0L)
~operations_hash: Alpha_environment.Operation_list_list_hash.zero in
initial_context
@@ -246,7 +247,7 @@ module Context_init = struct
let main n =
init n >>=? fun ((ctxt, header, hash), accounts, contracts) ->
- let timestamp = Tezos_base.Time.now () in
+ let timestamp = Environment.Time.of_seconds @@ Int64.of_float @@ Unix.time () in
begin_construction ~timestamp ~header ~hash ctxt >>=? fun ctxt ->
return (ctxt, accounts, contracts)
diff --git a/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam b/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam
index 042ecff48..4a4e6cfc8 100644
--- a/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam
+++ b/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam
@@ -39,6 +39,7 @@ depends: [
"tezos-data-encoding"
"tezos-protocol-environment"
"tezos-protocol-alpha"
+ "tezos-protocol-alpha-parameters"
"michelson-parser"
"simple-utils"
"tezos-utils"
diff --git a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml
index bd5f6c1fe..395be29b0 100644
--- a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml
+++ b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml
@@ -4,15 +4,940 @@ include Memory_proto_alpha
let init_environment = Init_proto_alpha.init_environment
let dummy_environment = Init_proto_alpha.dummy_environment
-open X_error_monad
+
+open Protocol
open Script_typed_ir
open Script_ir_translator
open Script_interpreter
+module X = struct
+ open Alpha_context
+ open Script_tc_errors
+ open Alpha_environment.Error_monad
+let rec stack_ty_eq
+ : type ta tb. context -> int -> ta stack_ty -> tb stack_ty ->
+ ((ta stack_ty, tb stack_ty) eq * context) tzresult
+ = fun ctxt lvl ta tb ->
+ match ta, tb with
+ | Item_t (tva, ra, _), Item_t (tvb, rb, _) ->
+ ty_eq ctxt tva tvb |>
+ record_trace (Bad_stack_item lvl) >>? fun (Eq, ctxt) ->
+ stack_ty_eq ctxt (lvl + 1) ra rb >>? fun (Eq, ctxt) ->
+ (Ok (Eq, ctxt) : ((ta stack_ty, tb stack_ty) eq * context) tzresult)
+ | Empty_t, Empty_t -> Ok (Eq, ctxt)
+ | _, _ -> error Bad_stack_length
+
+ open Script_typed_ir
+ open Protocol.Environment.Error_monad
+ module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse
+ open Tezos_micheline.Micheline
+ open Michelson_v1_primitives
+ open Protocol.Environment
+
+ type ex_typed_value =
+ Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
+
+
+ let rec unparse_data_generic
+ : type a. context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t) ->
+ unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
+ = fun ctxt ?(mapper = fun _ -> return None) mode ty a ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
+ mapper (Ex_typed_value (ty, a)) >>=? function
+ | Some x -> return (x, ctxt)
+ | None -> (
+ match ty, a with
+ | Unit_t _, () ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->
+ return (Prim (-1, D_Unit, [], []), ctxt)
+ | Int_t _, v ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+ return (Int (-1, Script_int.to_zint v), ctxt)
+ | Nat_t _, v ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+ return (Int (-1, Script_int.to_zint v), ctxt)
+ | String_t _, s ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->
+ return (String (-1, s), ctxt)
+ | Bytes_t _, s ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->
+ return (Bytes (-1, s), ctxt)
+ | Bool_t _, true ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+ return (Prim (-1, D_True, [], []), ctxt)
+ | Bool_t _, false ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+ return (Prim (-1, D_False, [], []), ctxt)
+ | Timestamp_t _, t ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+ | Readable ->
+ match Script_timestamp.to_notation t with
+ | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+ | Some s -> return (String (-1, s), ctxt)
+ end
+ | Address_t _, c ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+ end
+ | Contract_t _, (_, c) ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+ end
+ | Signature_t _, s ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable ->
+ return (String (-1, Signature.to_b58check s), ctxt)
+ end
+ | Mutez_t _, v ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->
+ return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
+ | Key_t _, k ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable ->
+ return (String (-1, Signature.Public_key.to_b58check k), ctxt)
+ end
+ | Key_hash_t _, k ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->
+ begin
+ match mode with
+ | Optimized ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
+ return (Bytes (-1, bytes), ctxt)
+ | Readable ->
+ return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
+ end
+ | Operation_t _, op ->
+ let bytes = Data_encoding.Binary.to_bytes_exn Alpha_context.Operation.internal_operation_encoding op in
+ Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
+ return (Bytes (-1, bytes), ctxt)
+ | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+ unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+ return (Prim (-1, D_Pair, [ l; r ], []), ctxt)
+ | Union_t ((tl, _), _, _), L l ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+ return (Prim (-1, D_Left, [ l ], []), ctxt)
+ | Union_t (_, (tr, _), _), R r ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+ return (Prim (-1, D_Right, [ r ], []), ctxt)
+ | Option_t ((t, _), _, _), Some v ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode t v >>=? fun (v, ctxt) ->
+ return (Prim (-1, D_Some, [ v ], []), ctxt)
+ | Option_t _, None ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->
+ return (Prim (-1, D_None, [], []), ctxt)
+ | List_t (t, _), items ->
+ fold_left_s
+ (fun (l, ctxt) element ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode t element >>=? fun (unparsed, ctxt) ->
+ return (unparsed :: l, ctxt))
+ ([], ctxt)
+ items >>=? fun (items, ctxt) ->
+ return (Micheline.Seq (-1, List.rev items), ctxt)
+ | Set_t (t, _), set ->
+ let t = ty_of_comparable_ty t in
+ fold_left_s
+ (fun (l, ctxt) item ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode t item >>=? fun (item, ctxt) ->
+ return (item :: l, ctxt))
+ ([], ctxt)
+ (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->
+ return (Micheline.Seq (-1, items), ctxt)
+ | Map_t (kt, vt, _), map ->
+ let kt = ty_of_comparable_ty kt in
+ fold_left_s
+ (fun (l, ctxt) (k, v) ->
+ Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
+ unparse_data_generic ~mapper ctxt mode kt k >>=? fun (key, ctxt) ->
+ unparse_data_generic ~mapper ctxt mode vt v >>=? fun (value, ctxt) ->
+ return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
+ ([], ctxt)
+ (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->
+ return (Micheline.Seq (-1, items), ctxt)
+ | Big_map_t (_kt, _kv, _), _map ->
+ return (Micheline.Seq (-1, []), ctxt)
+ | Lambda_t _, Lam (_, original_code) ->
+ unparse_code_generic ~mapper ctxt mode (root original_code)
+ )
+
+ and unparse_code_generic ctxt ?mapper mode = function
+ | Prim (loc, I_PUSH, [ ty ; data ], annot) ->
+ Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty) >>=? fun (Ex_ty t, ctxt) ->
+ parse_data ctxt t data >>=? fun (data, ctxt) ->
+ unparse_data_generic ?mapper ctxt mode t data >>=? fun (data, ctxt) ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)) >>=? fun ctxt ->
+ return (Prim (loc, I_PUSH, [ ty ; data ], annot), ctxt)
+ | Seq (loc, items) ->
+ fold_left_s
+ (fun (l, ctxt) item ->
+ unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+ return (item :: l, ctxt))
+ ([], ctxt) items >>=? fun (items, ctxt) ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))) >>=? fun ctxt ->
+ return (Micheline.Seq (loc, List.rev items), ctxt)
+ | Prim (loc, prim, items, annot) ->
+ fold_left_s
+ (fun (l, ctxt) item ->
+ unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+ return (item :: l, ctxt))
+ ([], ctxt) items >>=? fun (items, ctxt) ->
+ Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)) >>=? fun ctxt ->
+ return (Prim (loc, prim, List.rev items, annot), ctxt)
+ | Int _ | String _ | Bytes _ as atom -> return (atom, ctxt)
+
+module Interp_costs = Michelson_v1_gas.Cost_of
+type ex_descr_stack = Ex_descr_stack : (('a, 'b) descr * 'a stack) -> ex_descr_stack
+
+let unparse_stack ctxt (stack, stack_ty) =
+ (* We drop the gas limit as this function is only used for debugging/errors. *)
+ let ctxt = Gas.set_unlimited ctxt in
+ let rec unparse_stack
+ : type a. a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t
+ = function
+ | Empty, Empty_t -> return_nil
+ | Item (v, rest), Item_t (ty, rest_ty, annot) ->
+ unparse_data ctxt Readable ty v >>=? fun (data, _ctxt) ->
+ unparse_stack (rest, rest_ty) >>=? fun rest ->
+ let annot = match Script_ir_annot.unparse_var_annot annot with
+ | [] -> None
+ | [ a ] -> Some a
+ | _ -> assert false in
+ let data = Micheline.strip_locations data in
+ return ((data, annot) :: rest) in
+ unparse_stack (stack, stack_ty)
+
+let rec step
+ : type b a.
+ (?log: execution_trace ref ->
+ context ->
+ source: Contract.t ->
+ self: Contract.t ->
+ payer: Contract.t ->
+ ?visitor: (ex_descr_stack -> unit) ->
+ Tez.t ->
+ (b, a) descr -> b stack ->
+ (a stack * context) tzresult Lwt.t) =
+ fun ?log ctxt ~source ~self ~payer ?visitor amount ({ instr ; loc ; _ } as descr) stack ->
+ Lwt.return (Gas.consume ctxt Interp_costs.cycle) >>=? fun ctxt ->
+ (match visitor with
+ | Some visitor -> visitor @@ Ex_descr_stack(descr, stack)
+ | None -> ()) ;
+ let step_same ctxt = step ?log ctxt ~source ~self ~payer ?visitor amount in
+ let logged_return : type a b.
+ (b, a) descr ->
+ a stack * context ->
+ (a stack * context) tzresult Lwt.t =
+ fun descr (ret, ctxt) ->
+ match log with
+ | None -> return (ret, ctxt)
+ | Some log ->
+ trace
+ Cannot_serialize_log
+ (unparse_stack ctxt (ret, descr.aft)) >>=? fun stack ->
+ log := (descr.loc, Gas.level ctxt, stack) :: !log ;
+ return (ret, ctxt) in
+ let get_log (log : execution_trace ref option) =
+ Option.map ~f:(fun l -> List.rev !l) log in
+ let consume_gas_terop : type ret arg1 arg2 arg3 rest.
+ (_ * (_ * (_ * rest)), ret * rest) descr ->
+ ((arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3) ->
+ (arg1 -> arg2 -> arg3 -> Gas.cost) ->
+ rest stack ->
+ ((ret * rest) stack * context) tzresult Lwt.t =
+ fun descr (op, x1, x2, x3) cost_func rest ->
+ Lwt.return (Gas.consume ctxt (cost_func x1 x2 x3)) >>=? fun ctxt ->
+ logged_return descr (Item (op x1 x2 x3, rest), ctxt) in
+ let consume_gas_binop : type ret arg1 arg2 rest.
+ (_ * (_ * rest), ret * rest) descr ->
+ ((arg1 -> arg2 -> ret) * arg1 * arg2) ->
+ (arg1 -> arg2 -> Gas.cost) ->
+ rest stack ->
+ context ->
+ ((ret * rest) stack * context) tzresult Lwt.t =
+ fun descr (op, x1, x2) cost_func rest ctxt ->
+ Lwt.return (Gas.consume ctxt (cost_func x1 x2)) >>=? fun ctxt ->
+ logged_return descr (Item (op x1 x2, rest), ctxt) in
+ let consume_gas_unop : type ret arg rest.
+ (_ * rest, ret * rest) descr ->
+ ((arg -> ret) * arg) ->
+ (arg -> Gas.cost) ->
+ rest stack ->
+ context ->
+ ((ret * rest) stack * context) tzresult Lwt.t =
+ fun descr (op, arg) cost_func rest ctxt ->
+ Lwt.return (Gas.consume ctxt (cost_func arg)) >>=? fun ctxt ->
+ logged_return descr (Item (op arg, rest), ctxt) in
+ let consume_gaz_comparison :
+ type t rest.
+ (t * (t * rest), Script_int.z Script_int.num * rest) descr ->
+ (t -> t -> int) ->
+ (t -> t -> Gas.cost) ->
+ t -> t ->
+ rest stack ->
+ ((Script_int.z Script_int.num * rest) stack * context) tzresult Lwt.t =
+ fun descr op cost x1 x2 rest ->
+ Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt ->
+ logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in
+ let logged_return :
+ a stack * context ->
+ (a stack * context) tzresult Lwt.t =
+ logged_return descr in
+ match instr, stack with
+ (* stack ops *)
+ | Drop, Item (_, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+ logged_return (rest, ctxt)
+ | Dup, Item (v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+ logged_return (Item (v, Item (v, rest)), ctxt)
+ | Swap, Item (vi, Item (vo, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+ logged_return (Item (vo, Item (vi, rest)), ctxt)
+ | Const v, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+ logged_return (Item (v, rest), ctxt)
+ (* options *)
+ | Cons_some, Item (v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->
+ logged_return (Item (Some v, rest), ctxt)
+ | Cons_none _, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data) >>=? fun ctxt ->
+ logged_return (Item (None, rest), ctxt)
+ | If_none (bt, _), Item (None, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bt rest
+ | If_none (_, bf), Item (Some v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bf (Item (v, rest))
+ (* pairs *)
+ | Cons_pair, Item (a, Item (b, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.pair) >>=? fun ctxt ->
+ logged_return (Item ((a, b), rest), ctxt)
+ | Car, Item ((a, _), rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.pair_access) >>=? fun ctxt ->
+ logged_return (Item (a, rest), ctxt)
+ | Cdr, Item ((_, b), rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.pair_access) >>=? fun ctxt ->
+ logged_return (Item (b, rest), ctxt)
+ (* unions *)
+ | Left, Item (v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->
+ logged_return (Item (L v, rest), ctxt)
+ | Right, Item (v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->
+ logged_return (Item (R v, rest), ctxt)
+ | If_left (bt, _), Item (L v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bt (Item (v, rest))
+ | If_left (_, bf), Item (R v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bf (Item (v, rest))
+ (* lists *)
+ | Cons_list, Item (hd, Item (tl, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.cons) >>=? fun ctxt ->
+ logged_return (Item (hd :: tl, rest), ctxt)
+ | Nil, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data) >>=? fun ctxt ->
+ logged_return (Item ([], rest), ctxt)
+ | If_cons (_, bf), Item ([], rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bf rest
+ | If_cons (bt, _), Item (hd :: tl, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bt (Item (hd, Item (tl, rest)))
+ | List_map body, Item (l, rest) ->
+ let rec loop rest ctxt l acc =
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ match l with
+ | [] -> return (Item (List.rev acc, rest), ctxt)
+ | hd :: tl ->
+ step_same ctxt body (Item (hd, rest))
+ >>=? fun (Item (hd, rest), ctxt) ->
+ loop rest ctxt tl (hd :: acc)
+ in loop rest ctxt l [] >>=? fun (res, ctxt) ->
+ logged_return (res, ctxt)
+ | List_size, Item (list, rest) ->
+ Lwt.return
+ (List.fold_left
+ (fun acc _ ->
+ acc >>? fun (size, ctxt) ->
+ Gas.consume ctxt Interp_costs.list_size >>? fun ctxt ->
+ ok (size + 1 (* FIXME: overflow *), ctxt))
+ (ok (0, ctxt)) list) >>=? fun (len, ctxt) ->
+ logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)
+ | List_iter body, Item (l, init) ->
+ let rec loop ctxt l stack =
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ match l with
+ | [] -> return (stack, ctxt)
+ | hd :: tl ->
+ step_same ctxt body (Item (hd, stack))
+ >>=? fun (stack, ctxt) ->
+ loop ctxt tl stack
+ in loop ctxt l init >>=? fun (res, ctxt) ->
+ logged_return (res, ctxt)
+ (* sets *)
+ | Empty_set t, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt ->
+ logged_return (Item (empty_set t, rest), ctxt)
+ | Set_iter body, Item (set, init) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt ->
+ let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in
+ let rec loop ctxt l stack =
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ match l with
+ | [] -> return (stack, ctxt)
+ | hd :: tl ->
+ step_same ctxt body (Item (hd, stack))
+ >>=? fun (stack, ctxt) ->
+ loop ctxt tl stack
+ in loop ctxt l init >>=? fun (res, ctxt) ->
+ logged_return (res, ctxt)
+ | Set_mem, Item (v, Item (set, rest)) ->
+ consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt
+ | Set_update, Item (v, Item (presence, Item (set, rest))) ->
+ consume_gas_terop descr (set_update, v, presence, set) Interp_costs.set_update rest
+ | Set_size, Item (set, rest) ->
+ consume_gas_unop descr (set_size, set) (fun _ -> Interp_costs.set_size) rest ctxt
+ (* maps *)
+ | Empty_map (t, _), rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.empty_map) >>=? fun ctxt ->
+ logged_return (Item (empty_map t, rest), ctxt)
+ | Map_map body, Item (map, rest) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
+ let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
+ let rec loop rest ctxt l acc =
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ match l with
+ | [] -> return (acc, ctxt)
+ | (k, _) as hd :: tl ->
+ step_same ctxt body (Item (hd, rest))
+ >>=? fun (Item (hd, rest), ctxt) ->
+ loop rest ctxt tl (map_update k (Some hd) acc)
+ in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) ->
+ logged_return (Item (res, rest), ctxt)
+ | Map_iter body, Item (map, init) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
+ let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
+ let rec loop ctxt l stack =
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ match l with
+ | [] -> return (stack, ctxt)
+ | hd :: tl ->
+ step_same ctxt body (Item (hd, stack))
+ >>=? fun (stack, ctxt) ->
+ loop ctxt tl stack
+ in loop ctxt l init >>=? fun (res, ctxt) ->
+ logged_return (res, ctxt)
+ | Map_mem, Item (v, Item (map, rest)) ->
+ consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt
+ | Map_get, Item (v, Item (map, rest)) ->
+ consume_gas_binop descr (map_get, v, map) Interp_costs.map_get rest ctxt
+ | Map_update, Item (k, Item (v, Item (map, rest))) ->
+ consume_gas_terop descr (map_update, k, v, map) Interp_costs.map_update rest
+ | Map_size, Item (map, rest) ->
+ consume_gas_unop descr (map_size, map) (fun _ -> Interp_costs.map_size) rest ctxt
+ (* Big map operations *)
+ | Big_map_mem, Item (key, Item (map, rest)) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.big_map_mem key map)) >>=? fun ctxt ->
+ Script_ir_translator.big_map_mem ctxt self key map >>=? fun (res, ctxt) ->
+ logged_return (Item (res, rest), ctxt)
+ | Big_map_get, Item (key, Item (map, rest)) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.big_map_get key map)) >>=? fun ctxt ->
+ Script_ir_translator.big_map_get ctxt self key map >>=? fun (res, ctxt) ->
+ logged_return (Item (res, rest), ctxt)
+ | Big_map_update, Item (key, Item (maybe_value, Item (map, rest))) ->
+ consume_gas_terop descr
+ (Script_ir_translator.big_map_update, key, maybe_value, map)
+ Interp_costs.big_map_update rest
+ (* timestamp operations *)
+ | Add_seconds_to_timestamp, Item (n, Item (t, rest)) ->
+ consume_gas_binop descr
+ (Script_timestamp.add_delta, t, n)
+ Interp_costs.add_timestamp rest ctxt
+ | Add_timestamp_to_seconds, Item (t, Item (n, rest)) ->
+ consume_gas_binop descr (Script_timestamp.add_delta, t, n)
+ Interp_costs.add_timestamp rest ctxt
+ | Sub_timestamp_seconds, Item (t, Item (s, rest)) ->
+ consume_gas_binop descr (Script_timestamp.sub_delta, t, s)
+ Interp_costs.sub_timestamp rest ctxt
+ | Diff_timestamps, Item (t1, Item (t2, rest)) ->
+ consume_gas_binop descr (Script_timestamp.diff, t1, t2)
+ Interp_costs.diff_timestamps rest ctxt
+ (* string operations *)
+ | Concat_string_pair, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.concat_string [x; y])) >>=? fun ctxt ->
+ let s = String.concat "" [x; y] in
+ logged_return (Item (s, rest), ctxt)
+ | Concat_string, Item (ss, rest) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.concat_string ss)) >>=? fun ctxt ->
+ let s = String.concat "" ss in
+ logged_return (Item (s, rest), ctxt)
+ | Slice_string, Item (offset, Item (length, Item (s, rest))) ->
+ let s_length = Z.of_int (String.length s) in
+ let offset = Script_int.to_zint offset in
+ let length = Script_int.to_zint length in
+ if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
+ Lwt.return (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))) >>=? fun ctxt ->
+ logged_return (Item (Some (String.sub s (Z.to_int offset) (Z.to_int length)), rest), ctxt)
+ else
+ Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0)) >>=? fun ctxt ->
+ logged_return (Item (None, rest), ctxt)
+ | String_size, Item (s, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+ logged_return (Item (Script_int.(abs (of_int (String.length s))), rest), ctxt)
+ (* bytes operations *)
+ | Concat_bytes_pair, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes [x; y])) >>=? fun ctxt ->
+ let s = MBytes.concat "" [x; y] in
+ logged_return (Item (s, rest), ctxt)
+ | Concat_bytes, Item (ss, rest) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes ss)) >>=? fun ctxt ->
+ let s = MBytes.concat "" ss in
+ logged_return (Item (s, rest), ctxt)
+ | Slice_bytes, Item (offset, Item (length, Item (s, rest))) ->
+ let s_length = Z.of_int (MBytes.length s) in
+ let offset = Script_int.to_zint offset in
+ let length = Script_int.to_zint length in
+ if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
+ Lwt.return (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))) >>=? fun ctxt ->
+ logged_return (Item (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)), rest), ctxt)
+ else
+ Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0)) >>=? fun ctxt ->
+ logged_return (Item (None, rest), ctxt)
+ | Bytes_size, Item (s, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+ logged_return (Item (Script_int.(abs (of_int (MBytes.length s))), rest), ctxt)
+ (* currency operations *)
+ | Add_tez, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+ Lwt.return Tez.(x +? y) >>=? fun res ->
+ logged_return (Item (res, rest), ctxt)
+ | Sub_tez, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+ Lwt.return Tez.(x -? y) >>=? fun res ->
+ logged_return (Item (res, rest), ctxt)
+ | Mul_teznat, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+ Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64) >>=? fun ctxt ->
+ begin
+ match Script_int.to_int64 y with
+ | None -> fail (Overflow (loc, get_log log))
+ | Some y ->
+ Lwt.return Tez.(x *? y) >>=? fun res ->
+ logged_return (Item (res, rest), ctxt)
+ end
+ | Mul_nattez, Item (y, Item (x, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+ Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64) >>=? fun ctxt ->
+ begin
+ match Script_int.to_int64 y with
+ | None -> fail (Overflow (loc, get_log log))
+ | Some y ->
+ Lwt.return Tez.(x *? y) >>=? fun res ->
+ logged_return (Item (res, rest), ctxt)
+ end
+ (* boolean operations *)
+ | Or, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr ((||), x, y) Interp_costs.bool_binop rest ctxt
+ | And, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr ((&&), x, y) Interp_costs.bool_binop rest ctxt
+ | Xor, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Compare.Bool.(<>), x, y) Interp_costs.bool_binop rest ctxt
+ | Not, Item (x, rest) ->
+ consume_gas_unop descr (not, x) Interp_costs.bool_unop rest ctxt
+ (* integer operations *)
+ | Is_nat, Item (x, rest) ->
+ consume_gas_unop descr (Script_int.is_nat, x) Interp_costs.abs rest ctxt
+ | Abs_int, Item (x, rest) ->
+ consume_gas_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt
+ | Int_nat, Item (x, rest) ->
+ consume_gas_unop descr (Script_int.int, x) Interp_costs.int rest ctxt
+ | Neg_int, Item (x, rest) ->
+ consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
+ | Neg_nat, Item (x, rest) ->
+ consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
+ | Add_intint, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
+ | Add_intnat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
+ | Add_natint, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
+ | Add_natnat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.add_n, x, y) Interp_costs.add rest ctxt
+ | Sub_int, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.sub, x, y) Interp_costs.sub rest ctxt
+ | Mul_intint, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
+ | Mul_intnat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
+ | Mul_natint, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
+ | Mul_natnat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.mul_n, x, y) Interp_costs.mul rest ctxt
+ | Ediv_teznat, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->
+ let x = Script_int.of_int64 (Tez.to_mutez x) in
+ consume_gas_binop descr
+ ((fun x y ->
+ match Script_int.ediv x y with
+ | None -> None
+ | Some (q, r) ->
+ match Script_int.to_int64 q,
+ Script_int.to_int64 r with
+ | Some q, Some r ->
+ begin
+ match Tez.of_mutez q, Tez.of_mutez r with
+ | Some q, Some r -> Some (q,r)
+ (* Cannot overflow *)
+ | _ -> assert false
+ end
+ (* Cannot overflow *)
+ | _ -> assert false),
+ x, y)
+ Interp_costs.div
+ rest
+ ctxt
+ | Ediv_tez, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->
+ Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->
+ let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in
+ let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in
+ consume_gas_binop descr
+ ((fun x y -> match Script_int.ediv_n x y with
+ | None -> None
+ | Some (q, r) ->
+ match Script_int.to_int64 r with
+ | None -> assert false (* Cannot overflow *)
+ | Some r ->
+ match Tez.of_mutez r with
+ | None -> assert false (* Cannot overflow *)
+ | Some r -> Some (q, r)),
+ x, y)
+ Interp_costs.div
+ rest
+ ctxt
+ | Ediv_intint, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt
+ | Ediv_intnat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt
+ | Ediv_natint, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt
+ | Ediv_natnat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.ediv_n, x, y) Interp_costs.div rest ctxt
+ | Lsl_nat, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.shift_left x y)) >>=? fun ctxt ->
+ begin
+ match Script_int.shift_left_n x y with
+ | None -> fail (Overflow (loc, get_log log))
+ | Some x -> logged_return (Item (x, rest), ctxt)
+ end
+ | Lsr_nat, Item (x, Item (y, rest)) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.shift_right x y)) >>=? fun ctxt ->
+ begin
+ match Script_int.shift_right_n x y with
+ | None -> fail (Overflow (loc, get_log log))
+ | Some r -> logged_return (Item (r, rest), ctxt)
+ end
+ | Or_nat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.logor, x, y) Interp_costs.logor rest ctxt
+ | And_nat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand rest ctxt
+ | And_int_nat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand rest ctxt
+ | Xor_nat, Item (x, Item (y, rest)) ->
+ consume_gas_binop descr (Script_int.logxor, x, y) Interp_costs.logxor rest ctxt
+ | Not_int, Item (x, rest) ->
+ consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt
+ | Not_nat, Item (x, rest) ->
+ consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt
+ (* control *)
+ | Seq (hd, tl), stack ->
+ step_same ctxt hd stack >>=? fun (trans, ctxt) ->
+ step_same ctxt tl trans
+ | If (bt, _), Item (true, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bt rest
+ | If (_, bf), Item (false, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+ step_same ctxt bf rest
+ | Loop body, Item (true, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ step_same ctxt body rest >>=? fun (trans, ctxt) ->
+ step_same ctxt descr trans
+ | Loop _, Item (false, rest) ->
+ logged_return (rest, ctxt)
+ | Loop_left body, Item (L v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ step_same ctxt body (Item (v, rest)) >>=? fun (trans, ctxt) ->
+ step_same ctxt descr trans
+ | Loop_left _, Item (R v, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+ logged_return (Item (v, rest), ctxt)
+ | Dip b, Item (ign, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+ step_same ctxt b rest >>=? fun (res, ctxt) ->
+ logged_return (Item (ign, res), ctxt)
+ | Exec, Item (arg, Item (lam, rest)) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt ->
+ interp ?log ctxt ~source ~payer ~self amount lam arg >>=? fun (res, ctxt) ->
+ logged_return (Item (res, rest), ctxt)
+ | Lambda lam, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+ logged_return (Item (lam, rest), ctxt)
+ | Failwith tv, Item (v, _) ->
+ trace Cannot_serialize_failure
+ (unparse_data ctxt Optimized tv v) >>=? fun (v, _ctxt) ->
+ let v = Micheline.strip_locations v in
+ fail (Reject (loc, v, get_log log))
+ | Nop, stack ->
+ logged_return (stack, ctxt)
+ (* comparison *)
+ | Compare (Bool_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Compare.Bool.compare Interp_costs.compare_bool a b rest
+ | Compare (String_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Compare.String.compare Interp_costs.compare_string a b rest
+ | Compare (Bytes_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr MBytes.compare Interp_costs.compare_bytes a b rest
+ | Compare (Mutez_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Tez.compare Interp_costs.compare_tez a b rest
+ | Compare (Int_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Script_int.compare Interp_costs.compare_int a b rest
+ | Compare (Nat_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Script_int.compare Interp_costs.compare_nat a b rest
+ | Compare (Key_hash_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Signature.Public_key_hash.compare
+ Interp_costs.compare_key_hash a b rest
+ | Compare (Timestamp_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Script_timestamp.compare Interp_costs.compare_timestamp a b rest
+ | Compare (Address_key _), Item (a, Item (b, rest)) ->
+ consume_gaz_comparison descr Contract.compare Interp_costs.compare_address a b rest
+ (* comparators *)
+ | Eq, Item (cmpres, rest) ->
+ let cmpres = Script_int.compare cmpres Script_int.zero in
+ let cmpres = Compare.Int.(cmpres = 0) in
+ Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+ logged_return (Item (cmpres, rest), ctxt)
+ | Neq, Item (cmpres, rest) ->
+ let cmpres = Script_int.compare cmpres Script_int.zero in
+ let cmpres = Compare.Int.(cmpres <> 0) in
+ Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+ logged_return (Item (cmpres, rest), ctxt)
+ | Lt, Item (cmpres, rest) ->
+ let cmpres = Script_int.compare cmpres Script_int.zero in
+ let cmpres = Compare.Int.(cmpres < 0) in
+ Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+ logged_return (Item (cmpres, rest), ctxt)
+ | Le, Item (cmpres, rest) ->
+ let cmpres = Script_int.compare cmpres Script_int.zero in
+ let cmpres = Compare.Int.(cmpres <= 0) in
+ Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+ logged_return (Item (cmpres, rest), ctxt)
+ | Gt, Item (cmpres, rest) ->
+ let cmpres = Script_int.compare cmpres Script_int.zero in
+ let cmpres = Compare.Int.(cmpres > 0) in
+ Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+ logged_return (Item (cmpres, rest), ctxt)
+ | Ge, Item (cmpres, rest) ->
+ let cmpres = Script_int.compare cmpres Script_int.zero in
+ let cmpres = Compare.Int.(cmpres >= 0) in
+ Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+ logged_return (Item (cmpres, rest), ctxt)
+ (* packing *)
+ | Pack t, Item (value, rest) ->
+ Script_ir_translator.pack_data ctxt t value >>=? fun (bytes, ctxt) ->
+ logged_return (Item (bytes, rest), ctxt)
+ | Unpack t, Item (bytes, rest) ->
+ Lwt.return (Gas.check_enough ctxt (Script.serialized_cost bytes)) >>=? fun () ->
+ if Compare.Int.(MBytes.length bytes >= 1) &&
+ Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05) then
+ let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in
+ match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
+ | None ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
+ logged_return (Item (None, rest), ctxt)
+ | Some expr ->
+ Lwt.return (Gas.consume ctxt (Script.deserialized_cost expr)) >>=? fun ctxt ->
+ parse_data ctxt t (Micheline.root expr) >>= function
+ | Ok (value, ctxt) ->
+ logged_return (Item (Some value, rest), ctxt)
+ | Error _ignored ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
+ logged_return (Item (None, rest), ctxt)
+ else
+ logged_return (Item (None, rest), ctxt)
+ (* protocol *)
+ | Address, Item ((_, contract), rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.address) >>=? fun ctxt ->
+ logged_return (Item (contract, rest), ctxt)
+ | Contract t, Item (contract, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.contract) >>=? fun ctxt ->
+ Script_ir_translator.parse_contract_for_script ctxt loc t contract >>=? fun (ctxt, maybe_contract) ->
+ logged_return (Item (maybe_contract, rest), ctxt)
+ | Transfer_tokens,
+ Item (p, Item (amount, Item ((tp, destination), rest))) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
+ unparse_data ctxt Optimized tp p >>=? fun (p, ctxt) ->
+ let operation =
+ Transaction
+ { amount ; destination ;
+ parameters = Some (Script.lazy_expr (Micheline.strip_locations p)) } in
+ Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+ logged_return (Item (Internal_operation { source = self ; operation ; nonce }, rest), ctxt)
+ | Create_account,
+ Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
+ Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
+ let operation =
+ Origination
+ { credit ; manager ; delegate ; preorigination = Some contract ;
+ delegatable ; script = None ; spendable = true } in
+ Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+ logged_return (Item (Internal_operation { source = self ; operation ; nonce },
+ Item (contract, rest)), ctxt)
+ | Implicit_account, Item (key, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
+ let contract = Contract.implicit_contract key in
+ logged_return (Item ((Unit_t None, contract), rest), ctxt)
+ | Create_contract (storage_type, param_type, Lam (_, code)),
+ Item (manager, Item
+ (delegate, Item
+ (spendable, Item
+ (delegatable, Item
+ (credit, Item
+ (init, rest)))))) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->
+ unparse_ty ctxt param_type >>=? fun (unparsed_param_type, ctxt) ->
+ unparse_ty ctxt storage_type >>=? fun (unparsed_storage_type, ctxt) ->
+ let code =
+ Micheline.strip_locations
+ (Seq (0, [ Prim (0, K_parameter, [ unparsed_param_type ], []) ;
+ Prim (0, K_storage, [ unparsed_storage_type ], []) ;
+ Prim (0, K_code, [ Micheline.root code ], []) ])) in
+ unparse_data ctxt Optimized storage_type init >>=? fun (storage, ctxt) ->
+ let storage = Micheline.strip_locations storage in
+ Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
+ let operation =
+ Origination
+ { credit ; manager ; delegate ; preorigination = Some contract ;
+ delegatable ; spendable ;
+ script = Some { code = Script.lazy_expr code ;
+ storage = Script.lazy_expr storage } } in
+ Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+ logged_return
+ (Item (Internal_operation { source = self ; operation ; nonce },
+ Item (contract, rest)), ctxt)
+ | Set_delegate,
+ Item (delegate, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
+ let operation = Delegation delegate in
+ Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+ logged_return (Item (Internal_operation { source = self ; operation ; nonce }, rest), ctxt)
+ | Balance, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.balance) >>=? fun ctxt ->
+ Contract.get_balance ctxt self >>=? fun balance ->
+ logged_return (Item (balance, rest), ctxt)
+ | Now, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.now) >>=? fun ctxt ->
+ let now = Script_timestamp.now ctxt in
+ logged_return (Item (now, rest), ctxt)
+ | Check_signature, Item (key, Item (signature, Item (message, rest))) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.check_signature) >>=? fun ctxt ->
+ let res = Signature.check key signature message in
+ logged_return (Item (res, rest), ctxt)
+ | Hash_key, Item (key, rest) ->
+ Lwt.return (Gas.consume ctxt Interp_costs.hash_key) >>=? fun ctxt ->
+ logged_return (Item (Signature.Public_key.hash key, rest), ctxt)
+ | Blake2b, Item (bytes, rest) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 32)) >>=? fun ctxt ->
+ let hash = Raw_hashes.blake2b bytes in
+ logged_return (Item (hash, rest), ctxt)
+ | Sha256, Item (bytes, rest) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 32)) >>=? fun ctxt ->
+ let hash = Raw_hashes.sha256 bytes in
+ logged_return (Item (hash, rest), ctxt)
+ | Sha512, Item (bytes, rest) ->
+ Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 64)) >>=? fun ctxt ->
+ let hash = Raw_hashes.sha512 bytes in
+ logged_return (Item (hash, rest), ctxt)
+ | Steps_to_quota, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota) >>=? fun ctxt ->
+ let steps = match Gas.level ctxt with
+ | Limited { remaining } -> remaining
+ | Unaccounted -> Z.of_string "99999999" in
+ logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)
+ | Source, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
+ logged_return (Item (payer, rest), ctxt)
+ | Sender, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
+ logged_return (Item (source, rest), ctxt)
+ | Self t, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.self) >>=? fun ctxt ->
+ logged_return (Item ((t,self), rest), ctxt)
+ | Amount, rest ->
+ Lwt.return (Gas.consume ctxt Interp_costs.amount) >>=? fun ctxt ->
+ logged_return (Item (amount, rest), ctxt)
+
+and interp
+ : type p r.
+ (?log: execution_trace ref ->
+ context ->
+ source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->
+ (p, r) lambda -> p ->
+ (r * context) tzresult Lwt.t)
+ = fun ?log ctxt ~source ~payer ~self amount (Lam (code, _)) arg ->
+ let stack = (Item (arg, Empty)) in
+ begin match log with
+ | None -> return_unit
+ | Some log ->
+ trace Cannot_serialize_log
+ (unparse_stack ctxt (stack, code.bef)) >>=? fun stack ->
+ log := (code.loc, Gas.level ctxt, stack) :: !log ;
+ return_unit
+ end >>=? fun () ->
+ step ctxt ~source ~payer ~self amount code stack >>=? fun (Item (ret, Empty), ctxt) ->
+ return (ret, ctxt)
+
+
+
+end
+
+open X_error_monad
+
let stack_ty_eq (type a b)
?(tezos_context = dummy_environment.tezos_context)
(a:a stack_ty) (b:b stack_ty) =
- alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 a b) >>? fun (Eq, _) ->
+ alpha_wrap (X.stack_ty_eq tezos_context 0 a b) >>? fun (Eq, _) ->
ok Eq
let ty_eq (type a b)
@@ -37,7 +962,7 @@ let parse_michelson (type aft)
match j with
| Typed descr -> (
Lwt.return (
- alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
+ alpha_wrap (X.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
let descr : (_, aft) Script_typed_ir.descr = {descr with aft} in
Ok descr
)
@@ -59,7 +984,7 @@ let parse_michelson_fail (type aft)
match j with
| Typed descr -> (
Lwt.return (
- alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
+ alpha_wrap (X.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
let descr : (_, aft) Script_typed_ir.descr = {descr with aft} in
Ok descr
)
@@ -87,7 +1012,7 @@ let parse_michelson_ty
let unparse_michelson_data
?(tezos_context = dummy_environment.tezos_context)
?mapper ty value : Michelson.t tzresult Lwt.t =
- Script_ir_translator.unparse_data tezos_context ?mapper
+ X.unparse_data_generic tezos_context ?mapper
Readable ty value >>=?? fun (michelson, _) ->
return michelson
@@ -129,5 +1054,5 @@ let interpret ?(options = default_options) ?visitor (instr:('a, 'b) descr) (bef:
payer ;
amount ;
} = options in
- Script_interpreter.step tezos_context ~source ~self ~payer ?visitor amount instr bef >>=??
+ X.step tezos_context ~source ~self ~payer ?visitor amount instr bef >>=??
fun (stack, _) -> return stack
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/.gitignore b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/.gitignore
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/.gitignore
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/.gitignore
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/CHANGES.md b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/CHANGES.md
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/CHANGES.md
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/CHANGES.md
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/CONTRIBUTING.md b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/CONTRIBUTING.md
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/CONTRIBUTING.md
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/CONTRIBUTING.md
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/CREDITS b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/CREDITS
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/CREDITS
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/CREDITS
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/LICENSE.md b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/LICENSE.md
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/LICENSE.md
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/LICENSE.md
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/Makefile b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/Makefile
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/Makefile
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/Makefile
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/README.md b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/README.md
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/README.md
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/README.md
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/dune b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/dune
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/dune
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/dune
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/expander/dune b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/expander/dune
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/expander/dune
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/expander/dune
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/expander/ppx_let_expander.ml b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/expander/ppx_let_expander.ml
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/expander/ppx_let_expander.ml
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/expander/ppx_let_expander.ml
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/expander/ppx_let_expander.mli b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/expander/ppx_let_expander.mli
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/expander/ppx_let_expander.mli
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/expander/ppx_let_expander.mli
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/src/dune b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/src/dune
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/src/dune
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/src/dune
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/src/ppx_let.ml b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/src/ppx_let.ml
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/src/ppx_let.ml
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/src/ppx_let.ml
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/src/ppx_let.mli b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/src/ppx_let.mli
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/src/ppx_let.mli
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/src/ppx_let.mli
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/test/dune b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/test/dune
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/test/dune
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/test/dune
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/test/test-locations.mlt b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/test/test-locations.mlt
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/test/test-locations.mlt
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/test/test-locations.mlt
diff --git a/vendors/ligo-utils/simple-utils/ppx_let_generalized/test/test.ml b/vendors/ligo-utils/simple-utils/.ppx_let_generalized/test/test.ml
similarity index 100%
rename from vendors/ligo-utils/simple-utils/ppx_let_generalized/test/test.ml
rename to vendors/ligo-utils/simple-utils/.ppx_let_generalized/test/test.ml
diff --git a/vendors/ligo-utils/simple-utils/dune b/vendors/ligo-utils/simple-utils/dune
index 1cc6b0f37..73b0f7dd1 100644
--- a/vendors/ligo-utils/simple-utils/dune
+++ b/vendors/ligo-utils/simple-utils/dune
@@ -1,11 +1,12 @@
(library
(name simple_utils)
(public_name simple-utils)
- (preprocess
- (pps simple-utils.ppx_let_generalized))
(libraries
yojson
unix
str
)
+ (preprocess
+ (pps ppx_let)
+ )
)
diff --git a/vendors/ligo-utils/simple-utils/simple-utils.opam b/vendors/ligo-utils/simple-utils/simple-utils.opam
index 2a4cb4590..abb4cf437 100644
--- a/vendors/ligo-utils/simple-utils/simple-utils.opam
+++ b/vendors/ligo-utils/simple-utils/simple-utils.opam
@@ -10,36 +10,8 @@ bug-reports: "https://gitlab.com/ligolang/ligo-utils/issues"
depends: [
"dune"
"base"
- "base"
- "bigstring"
- "calendar"
- "cohttp-lwt-unix"
- "cstruct"
- "ezjsonm"
- "hex"
- "hidapi"
- "ipaddr"
- "irmin"
- "js_of_ocaml"
- "lwt"
- "lwt_log"
- "mtime"
- "ocplib-endian"
- "ocp-ocamlres"
- "re"
- "rresult"
- "stdio"
- "uri"
- "uutf"
- "zarith"
- "ocplib-json-typed"
- "ocplib-json-typed-bson"
- "tezos-crypto"
- "tezos-stdlib-unix"
- "tezos-data-encoding"
- "tezos-protocol-environment"
- "tezos-protocol-alpha"
- "michelson-parser"
+ "yojson"
+ "ppx_let"
# from ppx_let:
"ocaml" {>= "4.04.2" & < "4.08.0"}
"dune" {build & >= "1.5.1"}
diff --git a/vendors/ligo-utils/tezos-protocol-alpha-parameters/.ocamlformat b/vendors/ligo-utils/tezos-protocol-alpha-parameters/.ocamlformat
new file mode 100644
index 000000000..9d2a5a5f3
--- /dev/null
+++ b/vendors/ligo-utils/tezos-protocol-alpha-parameters/.ocamlformat
@@ -0,0 +1,11 @@
+wrap-fun-args=false
+let-binding-spacing=compact
+field-space=loose
+break-separators=after-and-docked
+sequence-style=separator
+doc-comments=before
+margin=80
+module-item-spacing=sparse
+parens-tuple=always
+parens-tuple-patterns=always
+break-string-literals=newlines-and-wrap
diff --git a/vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.ml b/vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.ml
new file mode 100644
index 000000000..b9dcfcf39
--- /dev/null
+++ b/vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.ml
@@ -0,0 +1,146 @@
+(*****************************************************************************)
+(* *)
+(* Open Source License *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. %s Id : %s
Category : %s's content left-margin *)
- (* TODO: pretty-(html)-print the schema *)
- open_vbox (-8);
- fprintf fmt "
Optional query arguments :
-
-Like explained above, your keys are stored under ``~/.tezos-client``.
-We strongly advice you to first **make a backup** and then
-transfer your tokens to a new pair of keys imported from a ledger (see
-`ledger`).
-
-Check the balance with:
-
-::
-
- tezos-client get balance for alice
-
-
-.. _tezos-admin-client:
-
-Admin Client
-------------
-
-The admin client gives access to more commands to interact with the
-peer-to-peer layer in order to:
-
-- check the status of the connections
-- force connections to known peers
-- ban/unban peers
-
-A useful command to debug a node that is not syncing is:
-
-::
-
- tezos-admin-client p2p stat
-
-
-.. _ledger:
-
-Ledger support
---------------
-
-**Disclaimer:** Ledger support is still in development, **the current app
-doesn't show all the needed information** for signing securely.
-Check frequently for updates.
-
-It is possible and advised to use a hardware wallet to manage your
-keys, Tezos' client supports the Ledger Nano S provided that you have
-the Tezos app installed.
-The app is developed by Obsidian Systems and they provide a comprehensive
-`tutorial on how to install it.
-`_
-
-Ledger Manager
-~~~~~~~~~~~~~~
-
-The preferred way to set up your Ledger is to install `Ledger
-Live
-`_.
-On Linux make sure you correctly set up your `udev` rules as explained
-`here `_.
-Connect your ledger, unlock it and go the dashboard.
-In Ledger Live `install Tezos Wallet` from the applications list and open it on the
-device.
-
-
-Tezos Wallet app
-~~~~~~~~~~~~~~~~
-
-Now on the client we can import the keys (make sure the device is
-in the Tezos Wallet app):
-
-::
-
- ./tezos-client list connected ledgers
-
-You can follow the instructions to import the ledger private key and
-you can choose between the root or a derived address.
-We can confirm the addition by listing known addresses.
-
-::
-
- ./tezos-client import secret key my_ledger ledger://tz1XXXXXXXXXX
- ./tezos-client list known addresses
-
-Optional: we can check that our ledger signs correctly using the
-following command and confirming on the device:
-
-::
-
- tezos-client show ledger path ledger://tz1XXXXXXXXXX
-
-The address can now be used as any other with the exception that
-during an operation the device will prompt you to confirm when it's
-time to sign an operation.
-
-
-Tezos Baking app
-~~~~~~~~~~~~~~~~
-
-In Ledger Live there is also a `Tezos Baking` app which allows a
-delegate to sign non-interactively e.g. there is no need to
-manually sign every block or endorsement.
-The application however is restricted to sign exclusively blocks and
-endorsement operations; it is not possible to sign for example a
-transfer.
-Furthermore the application keeps track of the last level baked and allows
-only to bake for increasing levels.
-This prevents signing blocks at levels below the latest
-block signed.
-
-If you have tried the app on Alphanet or Zeronet and want to change
-network you might need to reset this level with the command:
-
-::
-
- tezos-client set ledger high watermark for ledger://tz1XXXXXXXXXX to 0
-
-
-.. _private-mode:
-
-Private node
-------------
-
-The node can be set in private mode with the option ``--private-mode``
-so that:
-
-- it doesn't connects to any peer other than those provided with
- ``--peer`` or in bootstrap-peers
-- the peers connected to a private node don't include it in the list
- of peers sent to their neighborhood
-
-This feature is especially useful to hide a sensitive node that signs
-operations.
-
-For example we could have a set up with two nodes, a private one
-connected uniquely with a public one.
-The public node runs on a VPS, connects normally to the network and
-keeps an up to date state of the network while the private node runs at
-your home and is in charge of injecting and signing operations with a
-hardware wallet.
-
-::
-
- tezos-node run --rpc-addr [::] --private-mode \
- --no-bootstrap-peers \
- --bootstrap-threshold=1 \
- --connections 1 \
- --peer
-
-
-.. _signer:
-
-Signer
-------
-
-Another solution to decouple the node from the signing process is to
-use the *remote signer*.
-Among the signing scheme supported by the client, that we can list
-with ``tezos-client list signing schemes``, there are ``unix``,
-``tcp``, ``http`` and ``https``.
-These schemes send signing requests over their respective
-communication channel towards the ``tezos-signer``, which can run on a
-different machine that stores the secret key.
-
-In our home server we can generate a new key pair (or import one from a
-:ref:`Ledger`) and launch a signer that signs operations using these
-keys.
-The new keys are store in ``$HOME/.tezos-signer`` in the same format
-as ``tezos-client``.
-On our internet facing vps we can then import a key with the address
-of the signer.
-
-::
-
- home~$ tezos-signer gen keys alice
- home~$ cat ~/.tezos-signer/public_key_hashs
- [ { "name": "alice", "value": "tz1abc..." } ]
- home~$ tezos-signer launch socket signer -a home-ip
-
- vps~$ tezos-client import secret key alice tcp://home-ip:7732/tz1abc...
-
-Every time the client on *vps* needs to sing an operation for
-*alice*, it sends a signature request to the remote signer on
-*home*.
-Note that this setup alone is not secure, **the signer accepts
-requests from anybody and happily signs any transaction!**
-
-Secure the connection
-~~~~~~~~~~~~~~~~~~~~~
-
-Improving the security of the communication channel can be done at the
-system level, setting up a tunnel with ``ssh`` or ``wireguard``
-between *home* and *vps*, otherwise the signer already provides an
-additional protection.
-
-With the option ``--require-authentication`` the signer requires the
-client to authenticate before signing any operation.
-First we create a new key on the *vps* and then import it as an
-authorized key on *home* where it is stored under
-``.tezos-signer/authorized_keys`` (similarly to ``ssh``).
-Note that this key is only used to authenticate the client to the
-signer and it is not used as a Tezos account.
-
-::
-
- vps~$ tezos-client gen keys vps
- vps~$ cat ~/.tezos-client/public_keys
- [ { "name": "vps",
- "value":
- "unencrypted:edpk123456789" } ]
-
- home~$ tezos-signer add authorized key edpk123456789 --name vps
- home~$ tezos-signer --require-authentication launch socket signer -a home-ip
-
-All request are now signed with the *vps* key thus you are
-guaranteed authenticity and integrity.
-This set up **does not guarantee confidentiality**, an evesdropper can
-see the transactions that you sign but on a public blockchain this is
-less of a concern.
-You can still use the ``https`` scheme or the tunnel to encrypt your
-traffic.
-
-
-.. _sandboxed-mode:
-
-Use sandboxed mode
-------------------
-
-To run a ‘localhost-only’ instance of a Tezos network, we provide two
-helper scripts:
-
-- ``./src/bin_node/tezos-sandboxed-node.sh``
-- ``./src/bin_client/tezos-init-sandboxed-client.sh``
-
-
-Run a sandboxed node
-~~~~~~~~~~~~~~~~~~~~
-
-For instance, if you want to run local network with two nodes, in a
-first terminal, the following command will initialize a node listening
-for peers on port ``19731`` and listening for RPC on port ``18731``.
-
-::
-
- ./src/bin_node/tezos-sandboxed-node.sh 1 --connections 1
-
-This node will store its data in a temporary directory
-``/tmp/tezos-node.xxxxxxxx`` which will be removed when the node is
-stopped.
-The option ``--connections`` is just to remove the spurious “Too few
-connections” warnings by lowering the number of expected connection.
-
-To launch the second node, just run the following command, it will
-listen on port ``19739`` and ``18739``:
-
-::
-
- ./src/bin_node/tezos-sandboxed-node.sh 9 --connections 1
-
-You might replace ``1`` or ``9`` by any number in between if you want to
-run more than two nodes.
-
-
-Use the sandboxed client
-~~~~~~~~~~~~~~~~~~~~~~~~
-
-Once your node is running, open a new terminal and initialize the
-“sandboxed” client data in a temporary directory:
-
-::
-
- eval `./src/bin_client/tezos-init-sandboxed-client.sh 1`
-
-It also define in the current shell session an alias ``tezos-client``
-preconfigured for communicating with the same-numbered node.
-
-When you bootstrap a new network, the network is initialized with a
-dummy economic protocol, called `genesis`. If you want to run the same
-protocol than the alphanet, ``init-sandboxed-client`` also defines an
-alias ``tezos-activate-alpha``, that you need to execute once for
-activating the whole network.
-For instance:
-
-::
-
- $ tezos-client rpc get /chains/main/blocks/head/metadata
- "next_protocol": "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P"
- $ tezos-activate-alpha
- Injected BMV9KnSPE1yw
- $ tezos-client rpc get /chains/main/blocks/head/metadata
- "protocol": "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P"
-
-We now have the possibility to send transactions to the sandboxed network.
-As the genesis block used to initialize the sandboxed network differs from the
-one used in Alphanet and Zeronet, it is not possible to activate
-accounts obtained from the faucet. However, we can use the
-preconfigured accounts which can be listed with:
-
-::
-
- $ tezos-client list known addresses
-
- activator: tz1TGu6TN5GSez2ndXXeDX6LgUDvLzPLqgYV (unencrypted sk known)
- bootstrap5: tz1ddb9NMYHZi5UzPdzTZMYQQZoMub195zgv (unencrypted sk known)
- bootstrap4: tz1b7tUupMgCNw2cCLpKTkSD1NZzB5TkP2sv (unencrypted sk known)
- bootstrap3: tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU (unencrypted sk known)
- bootstrap2: tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN (unencrypted sk known)
- bootstrap1: tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx (unencrypted sk known)
-
-We can run the following command to transfer some Tez from one account to
-another:
-
-::
-
- $ tezos-client transfer 42 from bootstrap1 to bootstrap2 &
- ...
- Waiting for the operation to be included...
-
-You will notice that this command doesn't terminate (hence the ``&``),
-as usual it is waiting for the network to include the transaction in a
-block.
-Given that we are in a sandbox we need to bake a block ourselves and
-we can do so with the following command:
-
-::
-
- $ tezos-client bake for bootstrap1
-
-If the previous transaction is valid, the operation is included in the
-chain and the transfer terminates returning the usual ticket.
-Note that the ``bake for`` command of the client is exclusively for
-testing purposes, all baking should be done using the ``tezos-baker``
-binary.
-
-
-Tune protocol alpha parameters
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The ``tezos-active-alpha`` alias use parameters from
-``scripts/protocol_parameters.json`` to activate protocol alpha. It can
-be useful to tune these parameters when you need to debug something,
-for example, change the number of blocks per cycle, the time between
-blocks, etc.
-
-
-.. _node-conf:
-
-Configuration options for the node
-----------------------------------
-
-::
-
- ./tezos-node config init
-
-This will initialize a configuration file for the node in
-`$HOME/.tezos-node/config.json`, using default values. It only
-specifies that the node will listen to incoming connections on socket
-address ``[::]:9732``.
-
-The easiest way to amend this default configuration is to use
-
-::
-
- # Update the config file
- ./tezos-node config update <…>
- # Start from an empty cfg file
- ./tezos-node config reset <…>
-
-
-All blockchain data is stored under ``$HOME/.tezos-node/``. You can
-change this by doing `./tezos-node config update --data-dir
-`.
-
-To run multiple nodes on the same machine, you can duplicate and edit
-``$HOME/.tezos-node/config.json`` while making sure they don't share
-the same ``data-dir``. Then run your node with `./tezos-node
-run --config-file=`.
-
-Here is an example configuration file with all parameters specified.
-Most of the time it uses default values, except for cases where the
-default is not explanatory enough (i.e. “bootstrap-peers” is an empty
-list by default). Comments are not allowed in JSON, so this
-configuration file would not parse. They are just provided here to help
-writing your own configuration file if needed.
-
-::
-
- {
-
- /* Location of the data dir on disk. */
-
- "data-dir": "/home/tezos/my_data_dir"
-
- /* Configuration of net parameters */
-
- "net": {
-
- /* Floating point number between 0 and 256 that represents a
- difficulty, 24 signifies for example that at least 24 leading
- zeroes are expected in the hash. */
-
- "expected-proof-of-work": 24.5,
-
- /* List of hosts. Tezos can connect to both IPv6 and IPv4
- hosts. If the port is not specified, default port 9732 will be
- assumed. */
-
- "bootstrap-peers": ["::1:10732", "::ffff:192.168.1.3:9733", "mynode.tezos.com"],
-
- /* Specify if the node is in private mode or not. A node in
- private mode only opens outgoing connections to peers whose
- addresses are in [trusted_peers] and only accepts incoming
- connections from trusted peers. In addition, it informs these
- peers that the identity of the node should not be revealed to
- the rest of the network. */
-
- "private-mode": false,
-
- /* Network limits */
-
- "limits": {
-
- /* Delay granted to a peer to perform authentication, in
- seconds. */
-
- "authentication-timeout": 5,
-
- /* Strict minimum number of connections (triggers an urgent
- maintenance). */
-
- "min-connections": 50,
-
- /* Targeted number of connections to reach when bootstrapping /
- maintaining. */
-
- "expected-connections": 100,
-
- /* Maximum number of connections (exceeding peers are
- disconnected). */
-
- "max-connections": 200,
-
- /* Number above which pending incoming connections are
- immediately rejected. */
-
- "backlog": 20,
-
- /* Maximum allowed number of incoming connections that are
- pending authentication. */
-
- "max-incoming-connections": 20,
-
- /* Max download and upload speeds in KiB/s. */
-
- "max-download-speed": 1024,
- "max-upload-speed": 1024,
-
- /* Size of the buffer passed to read(2). */
-
- "read-buffer-size": 16384,
- }
- },
-
- /* Configuration of rpc parameters */
-
- "rpc": {
-
- /* Host to listen to. If the port is not specified, the default
- port 8732 will be assumed. */
-
- "listen-addr": "localhost:8733",
-
- /* Cross Origin Resource Sharing parameters, see
- https://en.wikipedia.org/wiki/Cross-origin_resource_sharing. */
-
- "cors-origin": [],
- "cors-headers": [],
-
- /* Certificate and key files (necessary when TLS is used). */
-
- "crt": "tezos-node.crt",
- "key": "tezos-node.key"
- },
-
- /* Configuration of log parameters */
-
- "log": {
-
- /* Output for the logging function. Either "stdout", "stderr" or
- the name of a log file . */
-
- "output": "tezos-node.log",
-
- /* Verbosity level: one of 'fatal', 'error', 'warn', 'notice',
- 'info', 'debug'. */
-
- "level": "info",
-
- /* Fine-grained logging instructions. Same format as described in
- `tezos-node run --help`, DEBUG section. In the example below,
- sections "net" and all sections starting by "client" will have
- their messages logged up to the debug level, whereas the rest of
- log sections will be logged up to the notice level. */
-
- "rules": "client* -> debug, net -> debug, * -> notice",
-
- /* Format for the log file, see
- http://ocsigen.org/lwt/dev/api/Lwt_log_core#2_Logtemplates. */
-
- "template": "$(date) - $(section): $(message)"
- },
-
- /* Configuration for the validator and mempool parameters */
-
- "shell": {
-
- /* The number of peers to synchronize with
- before declaring the node 'bootstrapped'. */
-
- "bootstrap_threshold": 4
-
- }
- }
-
-
-Environment for writing Michelson contracts
--------------------------------------------
-
-Here is how to setup a practical environment for
-writing, editing and debugging Michelson programs.
-
-Install `Emacs `_ with
-the `deferred `_ and
-`exec-path-from-shell
-`_ packages.
-The packages can be installed from within Emacs with
-``M-x package-install``.
-The last package imports the shell path in Emacs and it is needed
-because we will run a sandboxed node.
-
-Set up the `Michelson mode
-`_ by adding in
-your ``.emacs`` :
-
-::
-
- (load "~/tezos/tezos/emacs/michelson-mode.el" nil t)
- (setq michelson-client-command "tezos-client")
- (setq michelson-alphanet nil)
-
-Note that the Michelson mode will be chosen automatically by Emacs for
-files with a ``.tz`` or ``.tez`` extension.
-
-Run a :ref:`sandboxed node` (and activate the alphanet
-protocol with ``tezos-activate-alpha``) so that useful information
-about the program can be displayed.
-We can now open our favourite contract ``emacs
-./src/bin_client/test/contracts/id.tz`` and, when moving the cursor on
-a Michelson instruction, in the bottom of the windows Emacs should
-display the state of the stack before (left) and after (right) the
-application of the instruction.
-The Emacs mode automatically type-checks your program and reports
-errors; once you are happy with the result you can ask the client to
-run it locally:
-
-::
-
- tezos-client run script ./src/bin_client/test/contracts/id.tz \
- on storage '"hello"' and input '"world"'
-
-
-Debugging
----------
-
-It is possible to set independent log levels for different logging
-sections in Tezos, as well as specifying an output file for logging. See
-the description of log parameters above as well as documentation under
-the DEBUG section displayed by `tezos-node run –-help`.
diff --git a/vendors/tezos-modded/docs/logo.svg b/vendors/tezos-modded/docs/logo.svg
deleted file mode 100644
index 99da1d27a..000000000
--- a/vendors/tezos-modded/docs/logo.svg
+++ /dev/null
@@ -1,129 +0,0 @@
-
-
-
-
diff --git a/vendors/tezos-modded/docs/protocols/003_PsddFKi3.rst b/vendors/tezos-modded/docs/protocols/003_PsddFKi3.rst
deleted file mode 100644
index b3fa704a9..000000000
--- a/vendors/tezos-modded/docs/protocols/003_PsddFKi3.rst
+++ /dev/null
@@ -1,236 +0,0 @@
-.. _proto_003:
-
-Protocol 003_PsddFKi3
-=====================
-
-Description of the patch
-------------------------
-
-Fix to prevent account creation spam
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-While creating accounts currently requires a .257 tez burn, there is
-currently no cost to create implicit accounts, despite them occupying
-space in the context.
-This patch adjusts the cost to .257 tez for both regular (KT1) and
-implicit (tz1) accounts.
-
-Error handling for nonce revelation
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-In cycle 48, a baker who lost their deposits and rewards due to double
-baking also did not inject nonce revelation. The protocol reached an
-error condition after trying to take away rewards from an account for
-which rewards had already been slashed. As a result, no new blocks
-could be accepted unless the nonces were revealed. The patch ensures
-correct handling of this scenario.
-
-Add RPCs for voting
-~~~~~~~~~~~~~~~~~~~
-
-This patch introduces RPCs to query ballot status, functionality
-needed by bakers to interact with proposals to amend the protocol.
-They are the following::
-
- Sum of ballots cast so far during a voting period.
- GET /chains//blocks//votes/ballots
-
- Ballots cast so far during a voting period.
- GET /chains//blocks//votes/ballot_list
-
- Current period kind: proposal, testing_vote, testing, promotion_vote.
- GET /chains//blocks//votes/current_period_kind
-
- Current expected quorum.
- GET /chains//blocks//votes/current_quorum
-
- List of delegates with their voting weight, in number of rolls.
- GET /chains//blocks//votes/listings
-
- List of proposals with number of supporters.
- GET /chains//blocks//votes/proposals
-
- Current proposal under evaluation.
- GET /chains//blocks//votes/current_proposal
-
-Correct accounting for approval voting
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The current protocol does not properly count baking rolls during the
-approval voting phase. This is corrected in this version.
-
-
-How to apply the patch
-----------------------
-
-If compiling from source, please pull the latest code from the mainnet
-branch. From a clone of the git repository, a minimal update command
-is ``git checkout mainnet && git pull && eval $(opam env) && make
-build-deps && make``.
-Tezos binaries (node, client, baker, endorser, etc) should not be
-running while you re-compile.
-If using the script ``mainnet.sh`` based on docker provided at
-https://gitlab.com/tezos/tezos, simply do ``./mainnet.sh restart`` as
-every call to mainnet.sh checks for updates and updates if necessary.
-
-The node will automatically switch over to the new protocol at block
-height **204762** expected to occur after 2018-11-26T17:30:00 UTC.
-
-After updating, all processes (the node, baker, endorser, and accuser)
-should be restarted. The updated node handles multiple protocols but
-notice that there are several, protocol-specific, versions of every
-other processes.
-In order not to miss a block or an endorsement, you may run versions
-002_PsYLVpVv and 003_PsddFKi3 of the baker and endorser in parallel.
-Versions 003_PsddFKi3 of the baking and endorsement processes will not
-start baking or endorsing until the target block height. Version
-002_PsYLVpVv will stop by themselves and it will be safe to stop them
-at that time. This has been tested and the processes do not attempt to
-bake at the same height.
-
-However, as an extra precaution, specially if you do not use a
-hardware key or a remote-signer with a high water-mark, you may
-consider waiting until the target block height to shut down the old
-process and start the new one.)
-
-More details on fees and cost model
------------------------------------
-
-Protocol:
-~~~~~~~~~
-
-The creation of a new tz{1,2,3} address now requires a burn of `ꜩ0.257`,
-in-line with the creation of KT account.
-
-Every manager operation now costs at least ``10000`` in gas,
-a transaction has a default cost of ``10100`` in gas.
-
-Example::
-
- Reveal:
- Consumed gas: 10000
- Consumed storage: 0 bytes
-
- Transaction (when the target tz{1,2.3} is empty).
- Consumed gas: 10100
- Consumed storage: 277 bytes
-
- Transaction (when the target tz{1,2.3} is not empty).
- Consumed gas: 10100
- Consumed storage: 0 bytes
-
-
-Baker
-~~~~~
-
-The baker and mempool filters now require a minimal fee to propagate
-and include operations into blocks. This default is not set at the
-protocol level but rather in the configuration of the node and the baker.
-Bakers can thus decide of the settings that work best for them
-
-The minimal fee depends on the operation sent (transaction, origination,
-revelation, etc)
-
-When considering the injection of an operation in a block, the baker
-will check its size and gas and reject it if the associated fees are
-too low.
-The expected fees are computed using this formula::
-
- fees >= (minimal_fees + minimal_nanotez_per_byte * size + minimal_nanotez_per_gas_unit * gas)
-
-Where the size is the number of bytes of the complete serialized
-operation, i.e. including header and signature.
-When sending multiple transactions at once (i.e. packed operations),
-the baker will require the summed fees of all the operations to match
-the summed gas of all the operations and the total size of the packed
-operations, still including header and signature.
-
-By default::
-
- minimal_fees = 0.000 1 ꜩ (100 µꜩ)
- minimal_nanotez_per_gas_unit = 100 nꜩ/gu (0.000 000 1 ꜩ/gu)
- minimal_nanotez_per_byte = 1000 nꜩ/B (0.000 001 ꜩ/B)
-
-For instance, a single transaction to an existing implicit address
-will require a transaction fee of at least `0.001 273 ꜩ`
-to be included by bakers who choose to follow the default settings.
-
-These settings may be changed by passing the following flags to the baker
-(``--minimal-fees ``,
-``--minimal-nanotez-per-gas-unit ``,
-``--minimal-nanotez-per-byte ``).
-
-Delegates distributing rewards should be aware of these thresholds
-for their transactions to be successfully included.
-
-Node
-~~~~
-
-The node also filters operations following the same principles as
-above. If an operation does not carry sufficient fees, a node
-following the default setting will not include it in its mempool.
-Hence an operation without fee won't even propagate through
-the network. The constant can be changed with the following RPC
-call::
-
- ./tezos-client rpc post /chains/main/mempool/filter with '{ "minimal_fees": "0", "minimal_nanotez_per_gas_unit": "0", "minimal_nanotez_per_byte": "0" }'
-
-The constants used by the node and the baker do not need to be equal,
-but the node needs to be less restrictive than the baker, otherwise
-the baker won't even see the operations.
-
-An injection node (i.e. a specific node targeted by wallet for
-injection operation) might deactivate the filter (by using the
-previous RPC call) in order to accept any operation and give them a
-chance to be propagated to a baker that is willing to accept fee-less
-operations.
-
-
-FAQ
----
-
-Q. Who should apply this patch?
-
-A. Anyone running a node needs to update. If you are using a wallet
- that connects to a third party node, you do not need to apply a
- patch, but you can inquire with the wallet developers to make sure
- they are running a patched node. If you are delegating your tez you
- may wish to inquire with your baker that he is running the patched
- node in order not to miss any reward.
-
-Q. What are the risks and impact of account creation spam?
-
-A. Over time, account creation spam can make it uneconomical to run a
- node due to the amount of disk space required. This would make it
- harder for people to participate in the ecosystem.
-
-Q. What happens if I apply the patch early?
-
-A. The patch will automatically activate at a set block-height.
- Specifically, block height 204762 (approximately Monday Nov 26 1730
- UTC)
-
-Q. What happens if I don't apply the patch?
-
-A. Your node will continue tracking a branch with a known bug which
- does not represent the consensus among network participants.
-
-Q. Why not use the governance mechanism to correct these issues?
-
-A. The governance mechanism is a slow, deliberative, procedure for
- deciding on the evolution of the code. It is not a substitute for
- security patches which require quick deployment.
-
-Q. Why not mandate minimal transaction fees in the protocol?
-
-A. Transaction fees solve a slightly different problem, but they can
- help. If bakers wish to filter out transaction with low fees, they
- can run the process by passing the flag::
-
- --minimal-fees (default 0.000 1)
- --minimal-nanotez-per-byte (default 1000)
- --minimal-nanotez-per-gaz-unit (default 100)
-
- 1 mutez is equivalent to 1000 nanotez. The patch does include
- default minimal fees in the mempool, but individual bakers can
- choose to override these.
diff --git a/vendors/tezos-modded/docs/tutorials/data_encoding.rst b/vendors/tezos-modded/docs/tutorials/data_encoding.rst
deleted file mode 100644
index 0ed1e808e..000000000
--- a/vendors/tezos-modded/docs/tutorials/data_encoding.rst
+++ /dev/null
@@ -1,207 +0,0 @@
-.. _data_encoding:
-
-The ``data_encoding`` library
-=============================
-
-Throughout the Tezos protocol, data is serialized so that it can be used
-via RPC, written to disk, or placed in a block. This
-serialization/de-serialization is handled via the :package:`tezos-data-encoding`
-library by providing a set primitive encodings and a variety of combinators.
-
-Examples/Tutorial
------------------
-
-Encoding an integer
-~~~~~~~~~~~~~~~~~~~
-
-Integers are defined as other concrete data types with a generic
-encoding type ``type 'a encoding``. This means that it is an encoding
-to/from type ``int``. There are a variety of ways to encode an integer,
-depending on what binary serialization you want to achieve:
-
-- ``Data_encoding.int8``
-- ``Data_encoding.uint8``
-- ``Data_encoding.int16``
-- ``Data_encoding.uint16``
-- ``Data_encoding.int31``
-- ``Data_encoding.int32``
-- ``Data_encoding.int64``
-
-For example, an encoding that represents a 31 bit integer has type
-``Data_encoding.int31 = int Data_encoding.encoding``.
-
-.. code:: ocaml
-
- let int31_encoding = Data_encoding.int31
-
-Encoding an object
-~~~~~~~~~~~~~~~~~~
-
-Encoding a single integer is fairly uninteresting. The `Data_encoding`
-library provides a number of combinators that can be used to build more
-complicated objects. Consider the type that represents an interval from
-the first number to the second:
-
-.. code:: ocaml
-
- type interval = int64 * int64
-
-We can define an encoding for this type as:
-
-.. code:: ocaml
-
- let interval_encoding =
- Data_encoding.(obj2 (req "min" int64) (req "max" int64))
-
-In the example above we construct a new value ``interval_encoding`` by
-combining two `int64` integers using the ``obj2`` (object with two fields)
-constructor.
-
-The library provides different constructors, i.e. for objects that have
-no data (``Data_encoding.empty``), constructors for object up to 10
-fields, constructors for tuples, list, etc.
-
-These are serialized to binary by converting each internal object to
-binary and placing them in the order of the original object and to JSON
-as a JSON object with field names.
-
-Lists, arrays, and options
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-List, arrays and options types can by built on top of ground data types.
-
-.. code:: ocaml
-
- type interval_list = interval list
-
- type interval_array = interval array
-
- type interval_option = interval option
-
-And the encoders for these types as
-
-.. code:: ocaml
-
- let interval_list_encoding = Data_encoding.list interval_encoding
- let interval_array_encoding = Data_encoding.array interval_encoding
- let interval_option_encoding = Data_encoding.option interval_encoding
-
-Union types
-~~~~~~~~~~~
-
-The Tezos codebase makes heavy use of variant types. Consider the
-following variant type:
-
-.. code:: ocaml
-
- type variant = B of bool
- | S of string
-
-Encoding for this types can be expressed as:
-
-.. code:: ocaml
-
- let variant_encoding =
- Data_encoding.(union ~tag_size:`Uint8
- [ case
- bool
- (function B b -> Some b | _ -> None)
- (fun b -> B b) ;
- case
- string
- (function S s -> Some s | _ -> None)
- (fun s -> S s) ])
-
-This variant encoding is a bit more complicated. Let’s look at the parts
-of the encoding:
-
-- We include an optimization hint to the binary encoding to inform it
- of the number of elements we expect in the tag. In most cases, we can
- use :literal:`\`Uint8`, which allows you to have up to 256 possible
- cases (default).
-- We provide a function to wrap the datatype. The encoding works by
- repeatedly trying to decode the datatype using these functions until
- one returns ``Some payload``. This payload is then encoded using the
- dataencoding specified.
-- We specify a function from the encoded type to the actual datatype.
-
-Since the library does not provide an exhaustive check on these
-constructors, the user must be careful when constructing union types to
-avoid unfortunate runtime failures.
-
-How the Dataencoding module works
----------------------------------
-
-This section is 100% optional. You do not need to understand this
-section to use the library.
-
-The library uses GADTs to provide type-safe
-serialization/de-serialization. From there, a runtime representation of
-JSON objects is parsed into the type-safe version.
-
-First we define an untyped JSON AST:
-
-.. code:: ocaml
-
- type json =
- [ `O of (string * json) list
- | `Bool of bool
- | `Float of float
- | `A of json list
- | `Null
- | `String of string ]
-
-This is then parsed into a typed AST (we eliminate several cases for
-clarity):
-
-.. code:: ocaml
-
- type 'a desc =
- | Null : unit desc
- | Empty : unit desc
- | Bool : bool desc
- | Int64 : Int64.t desc
- | Float : float desc
- | Bytes : Kind.length -> MBytes.t desc
- | String : Kind.length -> string desc
- | String_enum : Kind.length * (string * 'a) list -> 'a desc
- | Array : 'a t -> 'a array desc
- | List : 'a t -> 'a list desc
- | Obj : 'a field -> 'a desc
- | Objs : Kind.t * 'a t * 'b t -> ('a * 'b) desc
- | Tup : 'a t -> 'a desc
- | Union : Kind.t * tag_size * 'a case list -> 'a desc
- | Mu : Kind.enum * string * ('a t -> 'a t) -> 'a desc
- | Conv :
- { proj : ('a -> 'b) ;
- inj : ('b -> 'a) ;
- encoding : 'b t ;
- schema : Json_schema.schema option } -> 'a desc
- | Describe :
- { title : string option ;
- description : string option ;
- encoding : 'a t } -> 'a desc
- | Def : { name : string ;
- encoding : 'a t } -> 'a desc
-
-- The first few constructors define all ground types.
-- The constructors for ``Bytes``, ``String`` and ``String_enum``
- include a length field in order to provide safe binary
- serialization.
-- The constructors for ``Array`` and ``List`` are used by the
- combinators we saw earlier.
-- The ``Obj`` and ``Objs`` constructors create JSON objects. These are
- wrapped in the ``Conv`` constructor to remove nesting that results
- when these constructors are used naively.
-- The ``Mu`` constructor is used to create self-referential
- definitions.
-- The ``Conv`` constructor allows you to clean up a nested definition
- or compute another type from an existing one.
-- The ``Describe`` and ``Def`` constructors are used to add
- documentation
-
-The library also provides various wrappers and convenience functions to
-make constructing these objects easier. Reading the documentation in the
-`mli file
-<../api/odoc/tezos-data-encoding/Tezos_data_encoding/Data_encoding/index.html>`__
-should orient you on how to use these functions.
diff --git a/vendors/tezos-modded/docs/tutorials/entering_alpha.rst b/vendors/tezos-modded/docs/tutorials/entering_alpha.rst
deleted file mode 100644
index fed1ea359..000000000
--- a/vendors/tezos-modded/docs/tutorials/entering_alpha.rst
+++ /dev/null
@@ -1,199 +0,0 @@
-.. _entering_alpha:
-
-How to start reading protocol Alpha
-===================================
-
-Protocol Alpha, whose Alpha has nothing to do with the one in Alphanet,
-is the name of the initial economic protocol. Alpha is a placeholder
-name, while we decide on the naming convention for protocol versions.
-
-Before reading that document, you may want to:
-
-- read the whitepaper,
-- read :ref:`how the economic protocol is
- sandboxed `.
-
-As all protocols, Alpha is made of a series of OCaml interface and
-implementation files, accompanied by a ``TEZOS_PROTOCOL`` file.
-
-The ``TEZOS_PROTOCOL`` structure
---------------------------------
-
-If you look at this file in the repository, you will see that it is
-composed of the hash of the sources, and the list of its modules, in
-linking order.
-
-Protocol Alpha is structured as a tower of abstraction layers, a coding
-discipline that we designed to have OCaml check as many invariants as
-possible at typing time. You will also see empty lines in
-``TEZOS_PROTOCOL`` that denote these layers of abstraction.
-
-These layers follow the linking order: the first modules are the tower’s
-foundation that talk to the raw key-value store, and going forward in
-the module list means climbing up the abstraction tower.
-
-The big abstraction barrier: ``Alpha_context``
-----------------------------------------------
-
-The proof-of-stake algorithm, as described in the white paper, relies on
-an abstract state of the ledger, that is read and transformed during
-validation of a block.
-
-Due to the polymorphic nature of Tezos, the ledger’s state (that we call
-**context** in the code), cannot be specific to protocol Alpha’s need.
-The proof-of-stake is thus implemented over a generic key-value store
-whose keys and associated binary data must implement the abstract
-structure.
-
-The ``Alpha_context`` module enforces the separation of concerns
-between, on one hand, mapping the abstract state of the ledger to the
-concrete structure of the key-value store, and, on the other hand,
-implementing the proof-of-stake algorithm over this state.
-
-In more practical terms, ``Alpha_context`` defines a type ``t`` that
-represents a state of the ledger. This state is an abstracted out
-version of the key-value store that can only be manipulated through the
-use of the few selected manipulations reexported by ``Alpha_context``,
-that always preserve the well-typed aspect and internal consistency
-invariants of the state.
-
-When validating a block, the low-level state that result from the
-predecessor block is read from the disk, then abstracted out to a
-``Alpha_context.t``, which is then only updated by high level operations
-that preserve consistency, and finally, the low level state is extracted
-to be committed on disk.
-
-This way, we have two well separated parts in the code. The code below
-``Alpha_context`` implements the ledger’s state storage, while the code
-on top of it is the proof-of-stake algorithm. Thanks to this barrier,
-the latter can remain nice, readable OCaml that only manipulates plain
-OCaml values.
-
-Below the ``Alpha_context``
----------------------------
-
-For this part, in a first discovery of the source code, you can start by
-relying mostly on this coarse grained description, with a little bit of
-cherry-picking when you’re curious about how a specific invariant is
-enforced.
-
-The ``*_repr`` modules
-~~~~~~~~~~~~~~~~~~~~~~
-
-These modules abstract the values of the raw key-value context by using
-:ref:`Data_encoding`.
-
-These modules define the data types used by the protocol that need to be
-serialized (amounts, contract handles, script expressions, etc.). For
-each type, it also defines its serialization format using
-:ref:`Data_encoding`.
-
-Above this layer, the code should never see the byte sequences in the
-database, the ones of transmitted blocks and operations, or the raw JSON
-of data transmitted via RPCs. It only manipulates OCaml values.
-
-The ``Storage`` module and storage functors
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Even with the concrete formats of values in the context abstracted out,
-type (or consistency) errors can still occur if the code accesses a
-value with a wrong key, or a key bound to another value. The next
-abstraction barrier is a remedy to that.
-
-The storage module is the single place in the protocol where key
-literals are defined. Hence, it is the only module necessary to audit,
-to know that the keys are not colliding.
-
-It also abstracts the keys, so that each kind of key get its own
-accessors. For instance, module ``Storage.Contract.Balance`` contains
-accessors specific to contracts’ balances.
-
-Moreover, the keys bear the type of the values they point to. For
-instance, only values of type ``Tez_repr.t`` can by stored at keys
-``Storage.Contract.Balance``. And in case a key is not a global key, but
-a parametric one, this key is parameterized by an OCaml value, and not the
-raw key part.
-
-So in the end, the only way to be used when accessing a contract balance
-is ``Storage.Contract.Balance.get``, which takes a ``Contract_repr.t``
-and gives a ``Tez_repr.t``.
-
-All these well-typed operations are generated by a set of functors, that
-come just before ``Storage`` in ``TEZOS_CONTEXT``.
-
-The ``*_storage`` modules
-~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The two previous steps ensure that the ledger’s state is always accessed
-and updated in a well-typed way.
-
-However, it does not enforce that, for instance, when a contract is
-deleted, all of the keys that store its state in the context are indeed
-deleted.
-
-This last series of modules named ``*_storage`` is there to enforce just
-that kind of invariants: ensuring the internal consistency of the
-context structure.
-
-These transaction do not go as far as checking that, for instance, when
-the destination of a transaction is credited, the source is also
-debited, as in some cases, it might not be the case.
-
-Above the ``Alpha_context``
----------------------------
-
-The three next sections describe the main entrypoints to the protocol:
-validation of blocks by the shell (that we often also call application),
-smart contracts, and RPC services.
-
-The ``Main`` module is the entrypoint that’s used by the shell. It
-respects the module type that all protocol must follow. For that, its
-code is mostly plumbing,
-
-Starting from ``Apply``
-~~~~~~~~~~~~~~~~~~~~~~~
-
-This is were you want to start on your first read. Even if some plumbing
-code is woven in, such as error cases declaration and registration, most
-of the proof-of-stake code has been written in a verbose style, to be
-understood with minimum OCaml knowledge.
-
-You want to start from the shell entry points (validation of the block
-header, validation of an operation, finalization of a block validation),
-and follow the control flow until you hit the ``Alpha_context``
-abstraction barrier. This will lead you to reading modules ``Baking``
-and ``Amendment``.
-
-Smart contracts
-~~~~~~~~~~~~~~~
-
-From ``Apply``, you will also end up in modules ``Script_ir_translator``
-and ``Script_interpreter``. The former is the typechecker of Michelson
-that is called when creating a new smart contract, and the latter is the
-interpreter that is called when transferring tokens to a new smart
-contract.
-
-Protocol RPC API
-~~~~~~~~~~~~~~~~
-
-Finally, the RPCs specific to Alpha are also defined above the
-``Alpha_context`` barrier.
-
-Services are defined in a few modules, divided by theme. Each module
-defines the RPC API: URL schemes with the types of parameters, and
-input and output JSON schemas. This interface serves three
-purposes. As it is thoroughly typed, it makes sure that the handlers
-(that are registered in the same file) have the right input and output
-types. It is also used by the client to perform RPC calls, to make
-sure that the URL schemes and JSON formats and consistent between the
-two parties. These two features are extremely useful when refactoring,
-as the OCaml typechecker will help us track the effects of an RPC API
-change on the whole codebase. The third purpose is of course, to make
-automatic documentation generation possible (as in ``tezos client rpc
-list/format``). Each service is also accompanied by a caller function,
-that can be used from the client to perform the calls, and by the
-tests to simulate calls in a fake in-memory context.
-
-It can be useful if you are a third party developer who wants to read
-the OCaml definition of the service hierarchy directly, instead of the
-automatically generated JSON hierarchy.
diff --git a/vendors/tezos-modded/docs/tutorials/error_monad.rst b/vendors/tezos-modded/docs/tutorials/error_monad.rst
deleted file mode 100644
index ddac11f6f..000000000
--- a/vendors/tezos-modded/docs/tutorials/error_monad.rst
+++ /dev/null
@@ -1,366 +0,0 @@
-.. _error_monad:
-
-The Error Monad
-===============
-
-This has been adapted from a blog post on *michelson-lang.com*.
-
-If you’re not familiar with monads, go take a few minutes and read a
-tutorial. I personally got a lot out of this
-`paper `__
-by Philip Wadler, but there are a ton of others available online. Find
-one that works for you. The error monad isn’t terribly scary as Monads
-go, so once you feel like you understand the gist, come on back and see
-if you can understand what’s going on.
-
-I’m going to omit some convenience operations that a lot of monads
-provide in the examples below. If you want to add them, they’re not
-difficult.
-
-Why you want the error monad
-----------------------------
-
-In Tezos, we don’t want to have the node be crashable by an improper
-input. To avoid this possibility, it was decided that the system should
-not use exceptions for error handling. Instead, it uses an error monad.
-This design forces errors to be handled or carried through before an
-output can be used. Exceptions are still occasionally used, but this is
-mostly in the client and only for internal errors.
-
-We also mix in the Lwt library, which we use for concurrency. This is
-combined with the error monad and is once again used pervasively
-throughout the codebase. The Lwt monad is a lot like promises in other
-languages.
-
-Without further ado, let’s write an error monad.
-
-A simple version of the error monad
------------------------------------
-
-Here’s a very simple error monad.
-
-.. code:: ocaml
-
- module Error : sig
- type 'a t
- (* Create a value of type t *)
- val return : 'a -> 'a t
- (* For when a computation fails *)
- val error : 'a t
- (* Apply an operation to a value in the error monad *)
- val (>>?) : 'a t -> ('a -> 'b t) -> 'b t (* bind *)
- end = struct
- type 'a t = Ok of 'a | Error
- let return x = Ok x
- let error = Error
- let (>>?) value func =
- match value with
- | Ok x -> func x
- | Error -> Error
- end
-
-So, is this what Tezos uses? We actually already have a lot of the
-structure that we’ll use later. The basic idea is that you return a
-value that’s correct and return an error if the operation failed.
-Outside of the error module, you can’t actually introspect an error
-value. You can only dispatch on the correctness/incorrectness of the
-value using bind.
-
-What’s wrong here?
-
-- We can’t report any information about an error case
-- We can’t report error traces, something that’s used to improve the
- quality of error messages throughout Tezos
-- We can’t handle some errors and continue executing
-
-A slight improvement
---------------------
-
-Let’s now enhance our error reporting by allowing errors to contain a
-description string. Now we can report messages along with our errors. Is
-this enough of an improvement? Not really. We don’t have any flexibility
-about how the printing works. We still can’t create error traces and we
-can’t handle errors and resume executing the program.
-
-.. code:: ocaml
-
- module Error : sig
- type 'a t
- val return : 'a -> 'a t
- val error : string -> 'a t
- val (>>?) : 'a t -> ('a -> 'b t) -> 'b t (* bind *)
- val print_value : ('a -> string) -> 'a t -> unit
- end = struct
- type 'a t = Ok of 'a | Error of string
- let return x = Ok x
- let error s = Error s
- let (>>?) value func =
- match value with
- | Ok x -> func x
- | Error s -> Error s
- let print_value func = function
- | Ok x -> Printf.printf "Success: %s\n" (func x)
- | Error s -> Printf.printf "Error: %s\n" s
- end
-
-Traces
-------
-
-Now that we have the basic structure down, we can add a mechanism to let
-us include traces. As a note, the error type I had above is exactly the
-``result`` type from the OCaml standard library. The traces are just
-lists of error messages. If you have a call you think might fail, and
-you want to provide a series of errors, you can wrap that result in the
-``trace`` function. If that call fails, an additional error is added.
-
-.. code:: ocaml
-
- module Error : sig
- type 'a t
- val return : 'a -> 'a t
- val error : string -> 'a t
- val (>>?) : 'a t -> ('a -> 'b t) -> 'b t (* bind *)
- val print_value : ('a -> string) -> 'a t -> unit
- val trace : string -> 'a t -> 'a t
- end = struct
- type 'a t = ('a, string list) result
- let return x = Ok x
- let error s = Error [ s ]
- let (>>?) value func =
- match value with
- | Ok x -> func x
- | Error errs -> Error errs
- let print_value func = function
- | Ok x -> Printf.printf "Success: %s\n" (func x)
- | Error [ s ] -> Printf.printf "Error: %s\n" s
- | Error errors -> Printf.printf "Errors:\t%s\n" (String.concat "\n\t" errors)
- let trace error = function
- | Ok x -> Ok x
- | Error errors -> Error (error :: errors)
- end
-
-A more descriptive message
---------------------------
-
-Even though traces are nice, we really want to be able to store more
-interesting data in the messages. We’re going to use an extensible
-variant type to do this. Extensible variants allow us to add a new case
-to a variant type at the cost of exhaustivity checking. We’re going to
-need two new mechanisms to make this work well. The first is an error
-registration scheme. In the actual error monad, this involves the data
-encoding module, which is how all data is encoded/decoded in Tezos. This
-module is another decently complicated part of the codebase that should
-probably the subject of a future post. Since you can declare arbitrary
-new errors, we’ll have a way of adding a printer for each error.
-
-When we add a new error handler, we’ll use the ``register_handler``
-function. This function will take a function that takes an error and
-returns a ``string option``. These functions will look something like
-this:
-
-.. code:: ocaml
-
- type error += Explosion_failure of string * int;;
-
- register_error
- (function
- | Explosion_failure (s, i) ->
- Some (Printf.sprintf "Everything exploded: %s at %d" s i)
- | _ -> None)
-
-I’m also renaming the ``error`` function to ``fail``. This is the
-convention used by the actual `Error_monad` module. I’m also exposing the
-``'a t`` type so that you can dispatch on it if you need to. This is
-used several times in the Tezos codebase.
-
-.. code:: ocaml
-
- module Error : sig
- type error = ..
- type 'a t = ('a, error list) result
- val return : 'a -> 'a t
- val fail : error -> 'a t
- val (>>?) : ('a -> 'b t) -> 'a t -> 'b t (* bind *)
- val print_value : ('a -> string) -> 'a t -> unit
- val trace : error -> 'a t -> 'a t
- end = struct
- type error = ..
- type 'a t = ('a, error list) result
- let fail error = Error [ error ]
- let return x = Ok x
- let (>>?) func = function
- | Ok x -> func x
- | Error errs -> Error errs
- let registered = ref []
- let register_error handler =
- registered := (handler :: !registered)
- let default_handler error =
- "Unregistered error: " ^ Obj.(extension_name @@ extension_constructor error)
- let to_string error =
- let rec find_handler = function
- | [] -> default_handler error
- | handler :: handlers ->
- begin match handler error with
- | None -> find_handler handlers
- | Some s -> s
- end
- in find_handler !registered
- let print_value func = function
- | Ok x -> Printf.printf "Success: %s\n" (func x)
- | Error [ s ] -> Printf.printf "Error: %s\n" (to_string s)
- | Error errors -> Printf.printf "Errors:\t%s\n" (String.concat "\n\t" (List.map to_string errors))
- let trace error = function
- | Ok x -> Ok x
- | Error errors -> Error (error :: errors)
- end
-
-Putting ``Lwt.t`` in the mix
-----------------------------
-
-Tezos uses the `Lwt library `__ for threading.
-The Lwt monad is mixed in with the error monad module. This requires us
-to add some extra combinators and reexport some functions from Lwt.
-
-I’m also renaming the type ``t`` to ``tzresult``, as used in the Tezos
-codebase.
-
-.. code:: ocaml
-
- module Error : sig
- type error = ..
- type 'a tzresult = ('a, error list) result
- val ok : 'a -> 'a tzresult
- val return : 'a -> 'a tzresult Lwt.t
- val error : error -> 'a tzresult
- val fail : error -> 'a tzresult Lwt.t
- val (>>?) : 'a tzresult -> ('a -> 'b tzresult) -> 'b tzresult (* bind *)
- val (>>=?) : 'a tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t
- val (>>=) : 'a Lwt.t -> ('a -> 'b Lwt.t) -> 'b Lwt.t
- val print_value : ('a -> string) -> 'a tzresult Lwt.t -> unit Lwt.t
- val trace : error -> 'a tzresult Lwt.t -> 'a tzresult Lwt.t
- end = struct
- type error = ..
- type 'a tzresult = ('a, error list) result
- let fail error = Lwt.return (Error [ error ])
- let error error = (Error [ error ])
- let ok x = Ok x
- let return x = Lwt.return (ok x)
- let (>>?) value func =
- match value with
- | Ok x -> func x
- | Error errs -> Error errs
- let (>>=) = Lwt.bind
- let (>>=?) value func =
- value >>= function
- | Ok x -> func x
- | Error errs -> Lwt.return (Error errs)
- let registered = ref []
- let register_error handler =
- registered := (handler :: !registered)
- let default_handler error =
- "Unregistered error: " ^ Obj.(extension_name @@ extension_constructor error)
- let to_string error =
- let rec find_handler = function
- | [] -> default_handler error
- | handler :: handlers ->
- begin match handler error with
- | None -> find_handler handlers
- | Some s -> s
- end
- in find_handler !registered
- let print_value func value =
- value >>= fun value ->
- begin match value with
- | Ok x -> Printf.printf "Success: %s\n" (func x)
- | Error [ s ] -> Printf.printf "Error: %s\n" (to_string s)
- | Error errors -> Printf.printf "Errors:\t%s\n" (String.concat "\n\t" (List.map to_string errors))
- end; Lwt.return ()
- let trace error value =
- value >>= function
- | Ok x -> return x
- | Error errors -> Lwt.return (Error (error :: errors))
- end
-
-The actual Tezos error monad
-----------------------------
-
-The actual Tezos error monad adds a few things. Firstly, there are three
-categories of errors:
-
-- :literal:`\`Temporary` - An error resulting from an operation that
- might be valid in the future, for example, a contract’s balance being
- too low to execute the intended operation. This can be fixed by
- adding more to the contract’s balance.
-- :literal:`\`Branch` - An error that occurs in one branch of the
- chain, but may not occur in a different one. For example, receiving
- an operation for an old or future protocol version.
-- :literal:`\`Permanent` - An error that is not recoverable because the
- operation is never going to be valid. For example, an invalid ꜩ
- notation.
-
-The registration scheme also uses data encodings. Here’s an example from
-the `validator <../api/odoc/tezos-node-shell/Tezos_node_shell/Validator/index.html>`__:
-
-.. code:: ocaml
-
- register_error_kind
- `Permanent
- ~id:"validator.wrong_level"
- ~title:"Wrong level"
- ~description:"The block level is not the expected one"
- ~pp:(fun ppf (e, g) ->
- Format.fprintf ppf
- "The declared level %ld is not %ld" g e)
- Data_encoding.(obj2
- (req "expected" int32)
- (req "provided" int32))
- (function Wrong_level (e, g) -> Some (e, g) | _ -> None)
- (fun (e, g) -> Wrong_level (e, g))
-
-An error takes a category, id, title, description, and encoding. You
-must specify a function to take an error to an optional value of the
-encoding type and a function to take a value of the encoded type and
-create an error value. A pretty printer can optionally be specified, but
-may also be omitted.
-
-The actual error monad and its tracing features can be seen in this
-function which parses contracts:
-
-.. code:: ocaml
-
- let parse_script
- : ?type_logger: (int * (Script.expr list * Script.expr list) -> unit) ->
- context -> Script.storage -> Script.code -> ex_script tzresult Lwt.t
- = fun ?type_logger ctxt
- { storage; storage_type = init_storage_type }
- { code; arg_type; ret_type; storage_type } ->
- trace
- (Ill_formed_type (Some "parameter", arg_type))
- (Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type) ->
- trace
- (Ill_formed_type (Some "return", ret_type))
- (Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type) ->
- trace
- (Ill_formed_type (Some "initial storage", init_storage_type))
- (Lwt.return (parse_ty init_storage_type)) >>=? fun (Ex_ty init_storage_type) ->
- trace
- (Ill_formed_type (Some "storage", storage_type))
- (Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type) ->
- let arg_type_full = Pair_t (arg_type, storage_type) in
- let ret_type_full = Pair_t (ret_type, storage_type) in
- Lwt.return (ty_eq init_storage_type storage_type) >>=? fun (Eq _) ->
- trace
- (Ill_typed_data (None, storage, storage_type))
- (parse_data ?type_logger ctxt storage_type storage) >>=? fun storage ->
- trace
- (Ill_typed_contract (code, arg_type, ret_type, storage_type, []))
- (parse_returning (Toplevel { storage_type }) ctxt ?type_logger arg_type_full ret_type_full code)
- >>=? fun code ->
- return (Ex_script { code; arg_type; ret_type; storage; storage_type })
-
-Each specific type error from the typechecking process is wrapped in a
-more general error that explains which part of the program was
-malformed. This improves the error reporting. You can also see the bind
-operator used between functions to continue only if an error does not
-occur. This function also operates in the ``Lwt`` monad, which is
-largely hidden via the error monad.
diff --git a/vendors/tezos-modded/docs/tutorials/michelson_anti_patterns.rst b/vendors/tezos-modded/docs/tutorials/michelson_anti_patterns.rst
deleted file mode 100644
index bf6ad897e..000000000
--- a/vendors/tezos-modded/docs/tutorials/michelson_anti_patterns.rst
+++ /dev/null
@@ -1,203 +0,0 @@
-Michelson Anti-Patterns
-=======================
-
-Even though Michelson is designed to make it easy to write secure
-contracts and difficult to write vulnerable ones, it is still possible
-to write buggy contracts that leak data and funds. This is a list of
-mistakes that you can make when writing or interacting with contracts on
-the Tezos blockchain and alternative ways to write code that avoid these
-problems.
-
-Note: We are currently reworking the concurrency model of Michelson (how
-and when sub-transactions are made), so that some of these patterns will
-be prevented by the language itself.
-
-Refunding to a list of contracts
---------------------------------
-
-One common pattern in contracts is to refund a group of people’s funds
-at once. This is problematic if you accepted arbitrary contracts as a
-malicious user can do cause various issues for you.
-
-Possible issues:
-~~~~~~~~~~~~~~~~
-
-- One contract swallows all the gas through a series of callbacks
-- One contract writes transactions until the block is full
-- Reentrancy bugs. Michelson intentionally makes these difficult to
- write, but it is still possible if you try.
-- A contract calls the \`FAIL\` instruction, stopping all computation.
-
-Alternatives/Solutions:
-~~~~~~~~~~~~~~~~~~~~~~~
-
-- Create a default account from people’s keys. Default accounts cannot
- execute code, avoiding the bugs above. Have people submit keys rather
- than contracts.
-- Have people pull their funds individually. Each user can break their
- own withdrawal only. **This does not protect against reentrancy
- bugs.**
-
-Avoid batch operations when users can increase the size of the batch
---------------------------------------------------------------------
-
-Contracts that rely on linear or super-linear operations are vulnerable
-to malicious users supplying values until the contract cannot finish
-without running into fuel limits. This can deadlock your contract.
-
-.. _possible-issues-1:
-
-Possible issues:
-~~~~~~~~~~~~~~~~
-
-- Malicious users can force your contract into a pathological worst
- case, stopping it from finishing with available gas. Note that in the
- absence of hard gas limits, this can still be disabling as node
- operators may not want to run contracts that take more than a certain
- amount of gas.
-- You may hit the slow case of an amortized algorithm or data structure
- at an inopportune time, using up all of your contract’s available
- gas.
-
-.. _alternativessolutions-1:
-
-Alternatives/Solutions:
-~~~~~~~~~~~~~~~~~~~~~~~
-
-- Avoid data structures and algorithms that rely on amortized
- operations, especially when users may add data.
-- Restrict the amount of data your contract can store to a level that
- will not overwhelm the available gas.
-- Write your contract so that it may pause and resume batch operations.
- This would complicate these sequences and require constant checking
- of available gas, but it prevents various attacks.
-
-\*Do not assume an attack will be prohibitively expensive\*
-Cryptocurrencies have extreme price fluctuations frequently and an
-extremely motivated attacker may decide that an enormous expense is
-justified. Remember, an attack that disables a contract is not just
-targeted at the authors, but also the users of that contract.
-
-Signatures alone do not prevent replay attacks
-----------------------------------------------
-
-If your contract uses signatures to authenticate messages, beware of
-replay attacks. If a user ever signs a piece of data, you *must* make
-sure that that piece of data is never again a valid message to the
-contract. If you do not do this, anyone else can call your contract with
-the same input and piggyback on the earlier approval.
-
-.. _possible-issues-2:
-
-Possible issues:
-~~~~~~~~~~~~~~~~
-
-- A previously approved action can be replayed.
-
-.. _alternativessolutions-2:
-
-Alternatives/Solutions
-~~~~~~~~~~~~~~~~~~~~~~
-
-- Use an internal counter to make the data you ask users to sign
- unique. This counter should be per key so that users can find out
- what they need to approve. This should be paired with a signed hash
- of your contract to prevent cross-contract replays.
-- Use the ``SENDER`` instruction to verify that the expected sender is
- the source of the message.
-
-Do not assume users will use a unique key for every smart contract
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Users should always use a different key for every contract with which
-they interact. If this is not the case, a message the user signed for
-another contract can be sent to your contract. An internal counter alone
-does not protect against this attack. It *must* be paired with a hash of
-your contract. You must verify the source of the message.
-
-Storing/transferring private data
----------------------------------
-
-Once data is published to anyone, including broadcasting a transaction,
-that data is public. Never transmit secret information via any part of
-the blockchain ecosystem. As soon as you have broadcast a transaction
-including that piece of information, anyone can see it. Furthermore,
-malicious nodes in the system can manipulate unsigned transactions by
-delaying, modifying, or reordering them.
-
-.. _possible-issues-3:
-
-Possible Issues
-~~~~~~~~~~~~~~~
-
-- If data is not signed, it can be modified
-- Transactions can be delayed
-- Secret information will become public
-
-.. _alternativessolutions-3:
-
-Alternatives/Solutions
-~~~~~~~~~~~~~~~~~~~~~~
-
-- Do not store private information on the blockchain or broadcast it in
- transactions.
-- Sign all transactions that contain information that, if manipulated,
- could be abused.
-- Use counters to enforce transaction orders.
-
-This will at least create a logical clock on messages sent to your
-contract.
-
-Not setting all state before a transfer
----------------------------------------
-
-Reentrancy is a potential issue on the blockchain. When a contract makes
-a transfer to another contract, that contract can execute its own code,
-and can make arbitrary further transfers, including back to the original
-contract. If state has not been updated before the transfer is made, a
-contract can call back in and execute actions based on old state.
-
-.. _possible-issues-4:
-
-Possible Issues
-~~~~~~~~~~~~~~~
-
-- Multiple withdrawals/actions
-- Generating illegal state if state is updated twice later
-
-.. _alternativessolutions-4:
-
-Alternatives/Solutions
-~~~~~~~~~~~~~~~~~~~~~~
-
-- Forbid reentrancy by means of a flag in your storage, unless you have
- a good reason to allow users to reenter your contract, this is likely
- the best option.
-- Only make transfers to trusted contracts or default accounts. Default
- accounts cannot execute code, so it is always safe to transfer to
- them. Before trusting a contract, make sure that its behavior cannot
- be modified and that you have an extremely high degree of confidence
- in it.
-
-Do not store funds for others in spendable contracts
-----------------------------------------------------
-
-Tezos allows contracts to be marked as spendable. Managers of spendable
-contracts can make transfers using the funds stored inside the contract.
-This can subvert guarantees about the contract’s behavior that are
-visible in the code.
-
-.. _possible-issues-5:
-
-Possible Issues
-~~~~~~~~~~~~~~~
-
-- The funds of a contract can be removed.
-- A contract may not be able to meet its obligations
-
-.. _alternativessolutions-5:
-
-Alternatives/Solutions
-~~~~~~~~~~~~~~~~~~~~~~
-
-- Do not store funds in spendable contracts that you do not control.
diff --git a/vendors/tezos-modded/docs/tutorials/profiling.rst b/vendors/tezos-modded/docs/tutorials/profiling.rst
deleted file mode 100644
index 4508e1635..000000000
--- a/vendors/tezos-modded/docs/tutorials/profiling.rst
+++ /dev/null
@@ -1,79 +0,0 @@
-Profiling the Tezos node
-========================
-
-Memory profiling the OCaml heap
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-- Install an OCaml switch with the `statmemprof` patch:
-
- ``4.04.2+statistical-memprof`` or ``4.06.0+statistical-memprof``
-
-- Install ``statmemprof-emacs``.
-
-- Enable loading `statmemprof` into the node.
-
- Add the ``statmemprof-emacs`` package as a dependency to the main package, and add
- ``let () = Statmemprof_emacs.start 1E-4 30 5`` to the ``node_main.ml`` file.
-
- Arguments:
-
- - ``sampling_rate`` is the sampling rate of the profiler. Good value: ``1e-4``.
- - ``callstack_size`` is the size of the fragment of the call stack which is captured for each sampled allocation.
- - ``min_sample_print`` is the minimum number of samples under which the location of an allocation is not displayed.
-
-- Load sturgeon into emacs, by adding this to your ``.emacs``:
-
-::
-
- (let ((opam-share (ignore-errors (car (process-lines "opam" "config" "var" "share")))))
- (when (and opam-share (file-directory-p opam-share))
- (add-to-list 'load-path (expand-file-name "emacs/site-lisp" opam-share))))
-
- (require 'sturgeon)
-
-- Launch the node then connect to it with sturgeon.
-
- If the process is launched with pid ``1234`` then
-
-::
-
- M-x sturgeon-connect
- tezos-nodememprof.1234.sturgeon
-
- (tab-completion works for finding the socket name)
-
-Memory profiling the C heap
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-- Install ``valgrind`` and ``massif-visualizer``
-
-::
-
- valgrind --tool=massif tezos-node run ...
-
-- Stop with `Ctrl-C` then display with
-
-::
-
- massif-visualizer massif.out.pid
-
-
-Performance profiling
-~~~~~~~~~~~~~~~~~~~~~
-
-- Install `perf` (the ``linux-perf`` package for debian).
-
- If the package does not exist for your current kernel, a previous
- version can be used. Substitute the ``perf`` command to ``perf_4.9``
- if your kernel is 4.9).
-
-- Run the node, find the pid.
-
-- Attach `perf` with ``perf record -p pid --call-stack dwarf``.
-
- Then stop capturing with ``Ctrl-C``. This can represent a lot of
- data. Don't do that for too long. If this is too much you can remove
- the ``--call-stack dwarf`` to get something more manageable, but
- interpreting the information can be harder.
-
-- display the result with ``perf report``
diff --git a/vendors/tezos-modded/docs/tutorials/protocol_environment.rst b/vendors/tezos-modded/docs/tutorials/protocol_environment.rst
deleted file mode 100644
index 31be8eeda..000000000
--- a/vendors/tezos-modded/docs/tutorials/protocol_environment.rst
+++ /dev/null
@@ -1,48 +0,0 @@
-.. _protocol_environment:
-
-Economic protocol sandboxing
-============================
-
-In Alpha, as in any sound future protocols, updates are approved by
-voting. That way, the responsibility of switching to a new protocol code
-is the responsibility of voters, and one could argue that it is up to
-them to check that the code does not call, for instance, unsafe array
-access functions.
-
-Yet, we decided to introduce a minimum level of machine checks, by
-compiling with a specific compiler that checks that no known-unsafe
-function is used. This static form of sandboxing is performed by the
-OCaml typechecker: we simply compile protocols in a restricted set of
-modules with restricted interfaces that hide any unsafe, non wanted
-feature.
-
-Another goal of that specific environment is maintaining a stable OCaml
-API for protocol development. Imagine that at some point, the OCaml
-standard library changes (a function is added or removed, a type is
-changed), then we will be able to upgrade to the new OCaml while still
-remaining compatible with past protocols, by providing an adapter layer.
-
-Here is a quick description of each file in this environment:
-
-- Files ``array.mli``, ``buffer.mli``, ``bytes.mli``, ``format.mli``,
- ``int32.mli``, ``int64.mli``, ``list.mli``, ``map.mli``,
- ``pervasives.mli``, ``set.mli`` and ``string.mli`` are stripped down
- interfaces to the OCaml standard library modules. The removed
- elements are: effects on toplevel references or channels, unsafe
- functions, functions that are known sources of bugs, and anything
- deprecated.
-- As we removed polymorphic comparison operators, ``compare.mli``
- implements monomorphic operators for standard OCaml and Tezos types.
- An example use is ``Compare.Int.(3 = 4)`` instead of plain OCaml
- ``(3 = 4)``.
-- Files ``lwt*`` is the stripped down interface to Lwt, of which we
- removed any non deterministic functions, since we only use Lwt for
- asynchronous access to the storage.
-- Files ``data_encoding.mli``, ``error_monad.mli``, ``mBytes.mli``,
- ``hash.mli``, ``base58.mli``, ``blake2B.mli``, ``ed25519.mli``,
- ``hex_encode.mli``, ``json.mli``, ``time.mli``, ``z.mli``,
- ``micheline.mli`` and files ``RPC_*`` are stripped down versions of
- the Tezos standard library.
-- Files ``tezos_data.mli``, ``context.mli``, ``fitness.mli`` and
- ``updater.mli`` are interfaces to the shell’s data definitions and
- storage accessors that are accessible to the protocol.
diff --git a/vendors/tezos-modded/docs/tutorials/rpc.rst b/vendors/tezos-modded/docs/tutorials/rpc.rst
deleted file mode 100644
index 686d03f51..000000000
--- a/vendors/tezos-modded/docs/tutorials/rpc.rst
+++ /dev/null
@@ -1,73 +0,0 @@
-.. _rpc:
-
-
-JSON/RPC interface
-==================
-
-The Tezos node provides a JSON/RPC interface. Note that it is an RPC,
-and it is JSON based, but it does not follow the “JSON-RPC” protocol. It
-is not active by default and it must be explicitly activated with the
-``--rpc-addr`` option. Typically, if you are not trying to run a local
-network and just want to explore the RPC, you would run:
-
-::
-
- ./tezos-node run --rpc-addr localhost
-
-The RPC interface is self-documented and the ``tezos-client`` executable
-is able to pretty-print the RPC API. For instance, to see the API
-provided by the Tezos Shell:
-
-::
-
- ./tezos-client rpc list
-
-To get API attached to the “genesis” block, including the remote
-procedures provided by the associated economic protocol version:
-
-::
-
- ./tezos-client rpc list /chains/main/blocks/genesis
-
-You might also want the JSON schema describing the expected input and
-output of a RPC. For instance:
-
-::
-
- ./tezos-client rpc schema get /chains/main/blocks/genesis/hash
-
-Note: you can get the same information, but as a raw JSON object, with a
-simple HTTP request:
-
-::
-
- curl -s localhost:8732/chains/main/blocks/head~10
- wget -O - http://localhost:8732/describe?recurse=true
- wget -O - http://localhost:8732/describe/chains/main/blocks/genesis?recurse=true
- wget -O - http://localhost:8732/describe/chains/main/blocks/genesis/hash
-
-
-An online :ref:`index ` of RPC calls is also available.
-
-The general call of an RPC from the client is ``tezos-admin-client rpc
-(get|post) ``.
-For instance, if you wish to request the current balance of a given
-block and contract, you can call the associated RPC via the command :
-``$ tezos-admin-client rpc get
-/blocks//proto/context/contracts//balance``.
-
-An RPC may take an *input* and generate an *output* both in JSON
-format. For example, the previous RPC call, that does not require an
-input, would display on the standard output : ``{ "balance":
-"4000000000000" }``. When calling a RPC that requires an input
-through command-line, you will be prompted to provide the JSON input
-in your default configured text editor. Alternatively, you can provide
-the JSON input using command
-``$ tezos-admin-client rpc post with ``. Don't forget to quote
-the JSON according to your shell rules.
-
-If you want to learn more about the exchange of RPCs between node and
-client you can pass the option `-l` and the client will print all the
-calls with their input/output.
-
-A useful util to manipulate JSON is `jq `_.
diff --git a/vendors/tezos-modded/docs/whitedoc/michelson.rst b/vendors/tezos-modded/docs/whitedoc/michelson.rst
deleted file mode 100644
index a309def41..000000000
--- a/vendors/tezos-modded/docs/whitedoc/michelson.rst
+++ /dev/null
@@ -1,3115 +0,0 @@
-.. _michelson:
-
-Michelson: the language of Smart Contracts in Tezos
-===================================================
-
-The language is stack based, with high level data types and primitives
-and strict static type checking. Its design cherry picks traits from
-several language families. Vigilant readers will notice direct
-references to Forth, Scheme, ML and Cat.
-
-A Michelson program is a series of instructions that are run in
-sequence: each instruction receives as input the stack resulting of the
-previous instruction, and rewrites it for the next one. The stack
-contains both immediate values and heap allocated structures. All values
-are immutable and garbage collected.
-
-A Michelson program receives as input a single element stack containing
-an input value and the contents of a storage space. It must return a
-single element stack containing an output value, a list of internal
-operations, and the new contents of the storage space. Alternatively,
-a Michelson program can fail, explicitly using a specific opcode,
-or because something went wrong that could not be caught by the type
-system (e.g. division by zero, gas exhaustion).
-
-The types of the input, output and storage are fixed and monomorphic,
-and the program is typechecked before being introduced into the system.
-No smart contract execution can fail because an instruction has been
-executed on a stack of unexpected length or contents.
-
-This specification gives the complete instruction set, type system and
-semantics of the language. It is meant as a precise reference manual,
-not an easy introduction. Even though, some examples are provided at the
-end of the document and can be read first or at the same time as the
-specification.
-
-Table of contents
------------------
-
-- I - Semantics
-- II - Type system
-- III - Core data types
-- IV - Core instructions
-- V - Operations
-- VI - Domain specific data types
-- VII - Domain specific operations
-- VIII - Macros
-- IX - Concrete syntax
-- X - JSON syntax
-- XI - Examples
-- XII - Full grammar
-- XIII - Reference implementation
-
-I - Semantics
--------------
-
-This specification gives a detailed formal semantics of the Michelson
-language. It explains in a symbolic way the computation performed by the
-Michelson interpreter on a given program and initial stack to produce
-the corresponding resulting stack. The Michelson interpreter is a pure
-function: it only builds a result stack from the elements of an initial
-one, without affecting its environment. This semantics is then naturally
-given in what is called a big step form: a symbolic definition of a
-recursive reference interpreter. This definition takes the form of a
-list of rules that cover all the possible inputs of the interpreter
-(program and stack), and describe the computation of the corresponding
-resulting stacks.
-
-Rules form and selection
-~~~~~~~~~~~~~~~~~~~~~~~~
-
-The rules have the main following form.
-
-::
-
- > (syntax pattern) / (initial stack pattern) => (result stack pattern)
- iff (conditions)
- where (recursions)
- and (more recursions)
-
-The left hand side of the ``=>`` sign is used for selecting the rule.
-Given a program and an initial stack, one (and only one) rule can be
-selected using the following process. First, the toplevel structure of
-the program must match the syntax pattern. This is quite simple since
-there is only a few non trivial patterns to deal with instruction
-sequences, and the rest is made of trivial pattern that match one
-specific instruction. Then, the initial stack must match the initial
-stack pattern. Finally, some rules add extra conditions over the values
-in the stack that follow the ``iff`` keyword. Sometimes, several rules
-may apply in a given context. In this case, the one that appears first
-in this specification is to be selected. If no rule applies, the result
-is equivalent to the one for the explicit ``FAILWITH`` instruction. This
-case does not happen on well-typed programs, as explained in the next
-section.
-
-The right hand side describes the result of the interpreter if the rule
-applies. It consists in a stack pattern, whose part are either
-constants, or elements of the context (program and initial stack) that
-have been named on the left hand side of the ``=>`` sign.
-
-Recursive rules (big step form)
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Sometimes, the result of interpreting a program is derived from the
-result of interpreting another one (as in conditionals or function
-calls). In these cases, the rule contains a clause of the following
-form.
-
-::
-
- where (intermediate program) / (intermediate stack) => (partial result)
-
-This means that this rules applies in case interpreting the intermediate
-state on the left gives the pattern on the right.
-
-The left hand sign of the ``=>`` sign is constructed from elements of
-the initial state or other partial results, and the right hand side
-identify parts that can be used to build the result stack of the rule.
-
-If the partial result pattern does not actually match the result of the
-interpretation, then the result of the whole rule is equivalent to the
-one for the explicit ``FAILWITH`` instruction. Again, this case does not
-happen on well-typed programs, as explained in the next section.
-
-Format of patterns
-~~~~~~~~~~~~~~~~~~
-
-Code patterns are of one of the following syntactical forms.
-
-- ``INSTR`` (an uppercase identifier) is a simple instruction (e.g.
- ``DROP``);
-- ``INSTR (arg) ...`` is a compound instruction, whose arguments can be
- code, data or type patterns (e.g. ``PUSH nat 3``) ;
-- ``{ (instr) ; ... }`` is a possibly empty sequence of instructions,
- (e.g. ``IF { SWAP ; DROP } { DROP }``), nested sequences can drop the
- braces ;
-- ``name`` is a pattern that matches any program and names a part of
- the matched program that can be used to build the result ;
-- ``_`` is a pattern that matches any instruction.
-
-Stack patterns are of one of the following syntactical forms.
-
-- ``[FAILED]`` is the special failed state ;
-- ``[]`` is the empty stack ;
-- ``(top) : (rest)`` is a stack whose top element is matched by the
- data pattern ``(top)`` on the left, and whose remaining elements are
- matched by the stack pattern ``(rest)`` on the right (e.g.
- ``x : y : rest``) ;
-- ``name`` is a pattern that matches any stack and names it in order to
- use it to build the result ;
-- ``_`` is a pattern that matches any stack.
-
-Data patterns are of one of the following syntactical forms.
-
-- integer/natural number literals, (e.g. ``3``) ;
-- string literals, (e.g. ``"contents"``) ;
-- raw byte sequence literals (e.g. ``0xABCDEF42``)
-- ``Tag`` (capitalized) is a symbolic constant, (e.g. ``Unit``,
- ``True``, ``False``) ;
-- ``(Tag (arg) ...)`` tagged constructed data, (e.g. ``(Pair 3 4)``) ;
-- a code pattern for first class code values ;
-- ``name`` to name a value in order to use it to build the result ;
-- ``_`` to match any value.
-
-The domain of instruction names, symbolic constants and data
-constructors is fixed by this specification. Michelson does not let the
-programmer introduce its own types.
-
-Be aware that the syntax used in the specification may differ a bit from
-the concrete syntax, which is presented in Section IX. In particular,
-some instructions are annotated with types that are not present in the
-concrete language because they are synthesized by the typechecker.
-
-Shortcuts
-~~~~~~~~~
-
-Sometimes, it is easier to think (and shorter to write) in terms of
-program rewriting than in terms of big step semantics. When it is the
-case, and when both are equivalents, we write rules of the form:
-
-::
-
- p / S => S''
- where p' / S' => S''
-
-using the following shortcut:
-
-::
-
- p / S => p' / S'
-
-The concrete language also has some syntax sugar to group some common
-sequences of operations as one. This is described in this specification
-using a simple regular expression style recursive instruction rewriting.
-
-II - Introduction to the type system and notations
---------------------------------------------------
-
-This specification describes a type system for Michelson. To make things
-clear, in particular to readers that are not accustomed to reading
-formal programming language specifications, it does not give a
-typechecking or inference algorithm. It only gives an intentional
-definition of what we consider to be well-typed programs. For each
-syntactical form, it describes the stacks that are considered well-typed
-inputs, and the resulting outputs.
-
-The type system is sound, meaning that if a program can be given a type,
-then if run on a well-typed input stack, the interpreter will never
-apply an interpretation rule on a stack of unexpected length or
-contents. Also, it will never reach a state where it cannot select an
-appropriate rule to continue the execution. Well-typed programs do not
-block, and do not go wrong.
-
-Type notations
-~~~~~~~~~~~~~~
-
-The specification introduces notations for the types of values, terms
-and stacks. Apart from a subset of value types that appear in the form
-of type annotations in some places throughout the language, it is
-important to understand that this type language only exists in the
-specification.
-
-A stack type can be written:
-
-- ``[]`` for the empty stack ;
-- ``(top) : (rest)`` for the stack whose first value has type ``(top)``
- and queue has stack type ``(rest)``.
-
-Instructions, programs and primitives of the language are also typed,
-their types are written:
-
-::
-
- (type of stack before) -> (type of stack after)
-
-The types of values in the stack are written:
-
-- ``identifier`` for a primitive data-type (e.g. ``bool``),
-- ``identifier (arg)`` for a parametric data-type with one parameter
- type ``(arg)`` (e.g. ``list nat``),
-- ``identifier (arg) ...`` for a parametric data-type with several
- parameters (e.g. ``map string int``),
-- ``[ (type of stack before) -> (type of stack after) ]`` for a code
- quotation, (e.g. ``[ int : int : [] -> int : [] ]``),
-- ``lambda (arg) (ret)`` is a shortcut for
- ``[ (arg) : [] -> (ret) : [] ]``.
-
-Meta type variables
-~~~~~~~~~~~~~~~~~~~
-
-The typing rules introduce meta type variables. To be clear, this has
-nothing to do with polymorphism, which Michelson does not have. These
-variables only live at the specification level, and are used to express
-the consistency between the parts of the program. For instance, the
-typing rule for the ``IF`` construct introduces meta variables to
-express that both branches must have the same type.
-
-Here are the notations for meta type variables:
-
-- ``'a`` for a type variable,
-- ``'A`` for a stack type variable,
-- ``_`` for an anonymous type or stack type variable.
-
-Typing rules
-~~~~~~~~~~~~
-
-The system is syntax directed, which means here that it defines a single
-typing rule for each syntax construct. A typing rule restricts the type
-of input stacks that are authorized for this syntax construct, links the
-output type to the input type, and links both of them to the
-subexpressions when needed, using meta type variables.
-
-Typing rules are of the form:
-
-::
-
- (syntax pattern)
- :: (type of stack before) -> (type of stack after) [rule-name]
- iff (premises)
-
-Where premises are typing requirements over subprograms or values in the
-stack, both of the form ``(x) :: (type)``, meaning that value ``(x)``
-must have type ``(type)``.
-
-A program is shown well-typed if one can find an instance of a rule that
-applies to the toplevel program expression, with all meta type variables
-replaced by non variable type expressions, and of which all type
-requirements in the premises can be proven well-typed in the same
-manner. For the reader unfamiliar with formal type systems, this is
-called building a typing derivation.
-
-Here is an example typing derivation on a small program that computes
-``(x+5)*10`` for a given input ``x``, obtained by instantiating the
-typing rules for instructions ``PUSH``, ``ADD`` and for the sequence, as
-found in the next sections. When instantiating, we replace the ``iff``
-with ``by``.
-
-::
-
- { PUSH nat 5 ; ADD ; PUSH nat 10 ; SWAP ; MUL }
- :: [ nat : [] -> nat : [] ]
- by { PUSH nat 5 ; ADD }
- :: [ nat : [] -> nat : [] ]
- by PUSH nat 5
- :: [ nat : [] -> nat : nat : [] ]
- by 5 :: nat
- and ADD
- :: [ nat : nat : [] -> nat : [] ]
- and { PUSH nat 10 ; SWAP ; MUL }
- :: [ nat : [] -> nat : [] ]
- by PUSH nat 10
- :: [ nat : [] -> nat : nat : [] ]
- by 10 :: nat
- and { SWAP ; MUL }
- :: [ nat : nat : [] -> nat : [] ]
- by SWAP
- :: [ nat : nat : [] -> nat : nat : [] ]
- and MUL
- :: [ nat : nat : [] -> nat : [] ]
-
-Producing such a typing derivation can be done in a number of manners,
-such as unification or abstract interpretation. In the implementation of
-Michelson, this is done by performing a recursive symbolic evaluation of
-the program on an abstract stack representing the input type provided by
-the programmer, and checking that the resulting symbolic stack is
-consistent with the expected result, also provided by the programmer.
-
-Side note
-~~~~~~~~~
-
-As with most type systems, it is incomplete. There are programs that
-cannot be given a type in this type system, yet that would not go wrong
-if executed. This is a necessary compromise to make the type system
-usable. Also, it is important to remember that the implementation of
-Michelson does not accept as many programs as the type system describes
-as well-typed. This is because the implementation uses a simple single
-pass typechecking algorithm, and does not handle any form of
-polymorphism.
-
-III - Core data types and notations
------------------------------------
-
-- ``string``, ``nat``, ``int`` and ``bytes``: The core primitive
- constant types.
-
-- ``bool``: The type for booleans whose values are ``True`` and
- ``False``
-
-- ``unit``: The type whose only value is ``Unit``, to use as a
- placeholder when some result or parameter is non necessary. For
- instance, when the only goal of a contract is to update its storage.
-
-- ``list (t)``: A single, immutable, homogeneous linked list, whose
- elements are of type ``(t)``, and that we note ``{}`` for the empty
- list or ``{ first ; ... }``. In the semantics, we use chevrons to
- denote a subsequence of elements. For instance ``{ head ; }``.
-
-- ``pair (l) (r)``: A pair of values ``a`` and ``b`` of types ``(l)``
- and ``(r)``, that we write ``(Pair a b)``.
-
-- ``option (t)``: Optional value of type ``(t)`` that we note ``None``
- or ``(Some v)``.
-
-- ``or (l) (r)``: A union of two types: a value holding either a value
- ``a`` of type ``(l)`` or a value ``b`` of type ``(r)``, that we write
- ``(Left a)`` or ``(Right b)``.
-
-- ``set (t)``: Immutable sets of values of type ``(t)`` that we note as
- lists ``{ item ; ... }``, of course with their elements unique, and
- sorted.
-
-- ``map (k) (t)``: Immutable maps from keys of type ``(k)`` of values
- of type ``(t)`` that we note ``{ Elt key value ; ... }``, with keys
- sorted.
-- ``big_map (k) (t)``: Lazily deserialized maps from keys of type
- ``(k)`` of values of type ``(t)`` that we note ``{ Elt key value ; ... }``,
- with keys sorted. These maps should be used if you intend to store
- large amounts of data in a map. They have higher gas costs than
- standard maps as data is lazily deserialized. You are limited to a
- single ``big_map`` per program, which must appear on the left hand
- side of a pair in the contract's storage.
-
-IV - Core instructions
-----------------------
-
-Control structures
-~~~~~~~~~~~~~~~~~~
-
-- ``FAILWITH``: Explicitly abort the current program.
-
- 'a :: \_ -> \_
-
- This special instruction aborts the current program exposing the top
- of the stack in its error message (first rule below). It makes the
- output useless since all subsequent instructions will simply ignore
- their usual semantics to propagate the failure up to the main result
- (second rule below). Its type is thus completely generic.
-
-::
-
- > FAILWITH / a : _ => [FAILED]
- > _ / [FAILED] => [FAILED]
-
-- ``{}``: Empty sequence.
-
-::
-
- :: 'A -> 'A
-
- > {} / SA => SA
-
-- ``{ I ; C }``: Sequence.
-
-::
-
- :: 'A -> 'C
- iff I :: [ 'A -> 'B ]
- C :: [ 'B -> 'C ]
-
- > I ; C / SA => SC
- where I / SA => SB
- and C / SB => SC
-
-- ``IF bt bf``: Conditional branching.
-
-::
-
- :: bool : 'A -> 'B
- iff bt :: [ 'A -> 'B ]
- bf :: [ 'A -> 'B ]
-
- > IF bt bf / True : S => bt / S
- > IF bt bf / False : S => bf / S
-
-- ``LOOP body``: A generic loop.
-
-::
-
- :: bool : 'A -> 'A
- iff body :: [ 'A -> bool : 'A ]
-
- > LOOP body / True : S => body ; LOOP body / S
- > LOOP body / False : S => S
-
-- ``LOOP_LEFT body``: A loop with an accumulator
-
-::
-
- :: (or 'a 'b) : 'A -> 'b : 'A
- iff body :: [ 'a : 'A -> (or 'a 'b) : 'A ]
-
- > LOOP_LEFT body / (Left a) : S => body ; LOOP_LEFT body / a : S
- > LOOP_LEFT body / (Right b) : S => b : S
-
-- ``DIP code``: Runs code protecting the top of the stack.
-
-::
-
- :: 'b : 'A -> 'b : 'C
- iff code :: [ 'A -> 'C ]
-
- > DIP code / x : S => x : S'
- where code / S => S'
-
-- ``EXEC``: Execute a function from the stack.
-
-::
-
- :: 'a : lambda 'a 'b : 'C -> 'b : 'C
-
- > EXEC / a : f : S => r : S
- where f / a : [] => r : []
-
-Stack operations
-~~~~~~~~~~~~~~~~
-
-- ``DROP``: Drop the top element of the stack.
-
-::
-
- :: _ : 'A -> 'A
-
- > DROP / _ : S => S
-
-- ``DUP``: Duplicate the top of the stack.
-
-::
-
- :: 'a : 'A -> 'a : 'a : 'A
-
- > DUP / x : S => x : x : S
-
-- ``SWAP``: Exchange the top two elements of the stack.
-
-::
-
- :: 'a : 'b : 'A -> 'b : 'a : 'A
-
- > SWAP / x : y : S => y : x : S
-
-- ``PUSH 'a x``: Push a constant value of a given type onto the stack.
-
-::
-
- :: 'A -> 'a : 'A
- iff x :: 'a
-
- > PUSH 'a x / S => x : S
-
-- ``UNIT``: Push a unit value onto the stack.
-
-::
-
- :: 'A -> unit : 'A
-
- > UNIT / S => Unit : S
-
-- ``LAMBDA 'a 'b code``: Push a lambda with given parameter and return
- types onto the stack.
-
-::
-
- :: 'A -> (lambda 'a 'b) : 'A
-
- > LAMBDA _ _ code / S => code : S
-
-Generic comparison
-~~~~~~~~~~~~~~~~~~
-
-Comparison only works on a class of types that we call comparable. A
-``COMPARE`` operation is defined in an ad hoc way for each comparable
-type, but the result of compare is always an ``int``, which can in turn
-be checked in a generic manner using the following combinators. The
-result of ``COMPARE`` is ``0`` if the top two elements of the stack are
-equal, negative if the first element in the stack is less than the
-second, and positive otherwise.
-
-- ``EQ``: Checks that the top of the stack EQuals zero.
-
-::
-
- :: int : 'S -> bool : 'S
-
- > EQ / 0 : S => True : S
- > EQ / v : S => False : S
- iff v <> 0
-
-- ``NEQ``: Checks that the top of the stack does Not EQual zero.
-
-::
-
- :: int : 'S -> bool : 'S
-
- > NEQ / 0 : S => False : S
- > NEQ / v : S => True : S
- iff v <> 0
-
-- ``LT``: Checks that the top of the stack is Less Than zero.
-
-::
-
- :: int : 'S -> bool : 'S
-
- > LT / v : S => True : S
- iff v < 0
- > LT / v : S => False : S
- iff v >= 0
-
-- ``GT``: Checks that the top of the stack is Greater Than zero.
-
-::
-
- :: int : 'S -> bool : 'S
-
- > GT / v : S => C / True : S
- iff v > 0
- > GT / v : S => C / False : S
- iff v <= 0
-
-- ``LE``: Checks that the top of the stack is Less Than of Equal to
- zero.
-
-::
-
- :: int : 'S -> bool : 'S
-
- > LE / v : S => True : S
- iff v <= 0
- > LE / v : S => False : S
- iff v > 0
-
-- ``GE``: Checks that the top of the stack is Greater Than of Equal to
- zero.
-
-::
-
- :: int : 'S -> bool : 'S
-
- > GE / v : S => True : S
- iff v >= 0
- > GE / v : S => False : S
- iff v < 0
-
-V - Operations
---------------
-
-Operations on booleans
-~~~~~~~~~~~~~~~~~~~~~~
-
-- ``OR``
-
-::
-
- :: bool : bool : 'S -> bool : 'S
-
- > OR / x : y : S => (x | y) : S
-
-- ``AND``
-
-::
-
- :: bool : bool : 'S -> bool : 'S
-
- > AND / x : y : S => (x & y) : S
-
-- ``XOR``
-
-::
-
- :: bool : bool : 'S -> bool : 'S
-
- > XOR / x : y : S => (x ^ y) : S
-
-- ``NOT``
-
-::
-
- :: bool : 'S -> bool : 'S
-
- > NOT / x : S => ~x : S
-
-Operations on integers and natural numbers
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Integers and naturals are arbitrary-precision, meaning the only size
-limit is fuel.
-
-- ``NEG``
-
-::
-
- :: int : 'S -> int : 'S
- :: nat : 'S -> int : 'S
-
- > NEG / x : S => -x : S
-
-- ``ABS``
-
-::
-
- :: int : 'S -> nat : 'S
-
- > ABS / x : S => abs (x) : S
-
-- ``ADD``
-
-::
-
- :: int : int : 'S -> int : 'S
- :: int : nat : 'S -> int : 'S
- :: nat : int : 'S -> int : 'S
- :: nat : nat : 'S -> nat : 'S
-
- > ADD / x : y : S => (x + y) : S
-
-- ``SUB``
-
-::
-
- :: int : int : 'S -> int : 'S
- :: int : nat : 'S -> int : 'S
- :: nat : int : 'S -> int : 'S
- :: nat : nat : 'S -> int : 'S
-
- > SUB / x : y : S => (x - y) : S
-
-- ``MUL``
-
-::
-
- :: int : int : 'S -> int : 'S
- :: int : nat : 'S -> int : 'S
- :: nat : int : 'S -> int : 'S
- :: nat : nat : 'S -> nat : 'S
-
- > MUL / x : y : S => (x * y) : S
-
-- ``EDIV`` Perform Euclidian division
-
-::
-
- :: int : int : 'S -> option (pair int nat) : 'S
- :: int : nat : 'S -> option (pair int nat) : 'S
- :: nat : int : 'S -> option (pair int nat) : 'S
- :: nat : nat : 'S -> option (pair nat nat) : 'S
-
- > EDIV / x : 0 : S => None : S
- > EDIV / x : y : S => Some (Pair (x / y) (x % y)) : S
- iff y <> 0
-
-Bitwise logical operators are also available on unsigned integers.
-
-- ``OR``
-
-::
-
- :: nat : nat : 'S -> nat : 'S
-
- > OR / x : y : S => (x | y) : S
-
-- ``AND`` (also available when the top operand is signed)
-
-::
-
- :: nat : nat : 'S -> nat : 'S
- :: int : nat : 'S -> nat : 'S
-
- > AND / x : y : S => (x & y) : S
-
-- ``XOR``
-
-::
-
- :: nat : nat : 'S -> nat : 'S
-
- > XOR / x : y : S => (x ^ y) : S
-
-- ``NOT`` The return type of ``NOT`` is an ``int`` and not a ``nat``.
- This is because the sign is also negated. The resulting integer is
- computed using two's complement. For instance, the boolean negation
- of ``0`` is ``-1``. To get a natural back, a possibility is to use
- ``AND`` with an unsigned mask afterwards.
-
-::
-
- :: nat : 'S -> int : 'S
- :: int : 'S -> int : 'S
-
- > NOT / x : S => ~x : S
-
-- ``LSL``
-
-::
-
- :: nat : nat : 'S -> nat : 'S
-
- > LSL / x : s : S => (x << s) : S
- iff s <= 256
- > LSL / x : s : S => [FAILED]
- iff s > 256
-
-- ``LSR``
-
-::
-
- :: nat : nat : 'S -> nat : 'S
-
- > LSR / x : s : S => (x >> s) : S
-
-- ``COMPARE``: Integer/natural comparison
-
-::
-
- :: int : int : 'S -> int : 'S
- :: nat : nat : 'S -> int : 'S
-
- > COMPARE / x : y : S => -1 : S
- iff x < y
- > COMPARE / x : y : S => 0 : S
- iff x = y
- > COMPARE / x : y : S => 1 : S
- iff x > y
-
-Operations on strings
-~~~~~~~~~~~~~~~~~~~~~
-
-Strings are mostly used for naming things without having to rely on
-external ID databases. They are restricted to the printable subset of
-7-bit ASCII, plus some escaped characters (see section on
-constants). So what can be done is basically use string constants as
-is, concatenate or splice them, and use them as keys.
-
-
-- ``CONCAT``: String concatenation.
-
-::
-
- :: string : string : 'S -> string : 'S
-
- > CONCAT / s : t : S => (s ^ t) : S
-
- :: string list : 'S -> string : 'S
-
- > CONCAT / {} : S => "" : S
- > CONCAT / { s ; } : S => (s ^ r) : S
- where CONCAT / { } : S => r : S
-
-- ``SIZE``: number of characters in a string.
-
-::
-
- :: string : 'S -> nat : 'S
-
-- ``SLICE``: String access.
-
-::
-
- :: nat : nat : string : 'S -> option string : 'S
-
- > SLICE / offset : length : s : S => Some ss : S
- where ss is the substring of s at the given offset and of the given length
- iff offset and (offset + length) are in bounds
- > SLICE / offset : length : s : S => None : S
- iff offset or (offset + length) are out of bounds
-
-- ``COMPARE``: Lexicographic comparison.
-
-::
-
- :: string : string : 'S -> int : 'S
-
- > COMPARE / s : t : S => -1 : S
- iff s < t
- > COMPARE / s : t : S => 0 : S
- iff s = t
- > COMPARE / s : t : S => 1 : S
- iff s > t
-
-Operations on pairs
-~~~~~~~~~~~~~~~~~~~
-
-- ``PAIR``: Build a pair from the stack's top two elements.
-
-::
-
- :: 'a : 'b : 'S -> pair 'a 'b : 'S
-
- > PAIR / a : b : S => (Pair a b) : S
-
-- ``CAR``: Access the left part of a pair.
-
-::
-
- :: pair 'a _ : 'S -> 'a : 'S
-
- > CAR / (Pair a _) : S => a : S
-
-- ``CDR``: Access the right part of a pair.
-
-::
-
- :: pair _ 'b : 'S -> 'b : 'S
-
- > CDR / (Pair _ b) : S => b : S
-
-Operations on sets
-~~~~~~~~~~~~~~~~~~
-
-- ``EMPTY_SET 'elt``: Build a new, empty set for elements of a given
- type.
-
- The ``'elt`` type must be comparable (the ``COMPARE``
- primitive must be defined over it).
-
-::
-
- :: 'S -> set 'elt : 'S
-
- > EMPTY_SET _ / S => {} : S
-
-- ``MEM``: Check for the presence of an element in a set.
-
-::
-
- :: 'elt : set 'elt : 'S -> bool : 'S
-
- > MEM / x : {} : S => false : S
- > MEM / x : { hd ; } : S => r : S
- iff COMPARE / x : hd : [] => 1 : []
- where MEM / x : { } : S => r : S
- > MEM / x : { hd ; } : S => true : S
- iff COMPARE / x : hd : [] => 0 : []
- > MEM / x : { hd ; } : S => false : S
- iff COMPARE / x : hd : [] => -1 : []
-
-- ``UPDATE``: Inserts or removes an element in a set, replacing a
- previous value.
-
-::
-
- :: 'elt : bool : set 'elt : 'S -> set 'elt : 'S
-
- > UPDATE / x : false : {} : S => {} : S
- > UPDATE / x : true : {} : S => { x } : S
- > UPDATE / x : v : { hd ; } : S => { hd ; } : S
- iff COMPARE / x : hd : [] => 1 : []
- where UPDATE / x : v : { } : S => { } : S
- > UPDATE / x : false : { hd ; } : S => { } : S
- iff COMPARE / x : hd : [] => 0 : []
- > UPDATE / x : true : { hd ; } : S => { hd ; } : S
- iff COMPARE / x : hd : [] => 0 : []
- > UPDATE / x : false : { hd ; } : S => { hd ; } : S
- iff COMPARE / x : hd : [] => -1 : []
- > UPDATE / x : true : { hd ; } : S => { x ; hd ; } : S
- iff COMPARE / x : hd : [] => -1 : []
-
-- ``ITER body``: Apply the body expression to each element of a set.
- The body sequence has access to the stack.
-
-::
-
- :: (set 'elt) : 'A -> 'A
- iff body :: [ 'elt : 'A -> 'A ]
-
- > ITER body / {} : S => S
- > ITER body / { hd ; } : S => body; ITER body / hd : { } : S
-
-- ``SIZE``: Get the cardinality of the set.
-
-::
-
- :: set 'elt : 'S -> nat : 'S
-
- > SIZE / {} : S => 0 : S
- > SIZE / { _ ; } : S => 1 + s : S
- where SIZE / { } : S => s : S
-
-Operations on maps
-~~~~~~~~~~~~~~~~~~
-
-- ``EMPTY_MAP 'key 'val``: Build a new, empty map from keys of a
- given type to values of another given type.
-
- The ``'key`` type must be comparable (the ``COMPARE`` primitive must
- be defined over it).
-
-::
-
- :: 'S -> map 'key 'val : 'S
-
- > EMPTY_MAP _ _ / S => {} : S
-
-
-- ``GET``: Access an element in a map, returns an optional value to be
- checked with ``IF_SOME``.
-
-::
-
- :: 'key : map 'key 'val : 'S -> option 'val : 'S
-
- > GET / x : {} : S => None : S
- > GET / x : { Elt k v ; } : S => opt_y : S
- iff COMPARE / x : k : [] => 1 : []
- where GET / x : { } : S => opt_y : S
- > GET / x : { Elt k v ; } : S => Some v : S
- iff COMPARE / x : k : [] => 0 : []
- > GET / x : { Elt k v ; } : S => None : S
- iff COMPARE / x : k : [] => -1 : []
-
-- ``MEM``: Check for the presence of a binding for a key in a map.
-
-::
-
- :: 'key : map 'key 'val : 'S -> bool : 'S
-
- > MEM / x : {} : S => false : S
- > MEM / x : { Elt k v ; } : S => r : S
- iff COMPARE / x : k : [] => 1 : []
- where MEM / x : { } : S => r : S
- > MEM / x : { Elt k v ; } : S => true : S
- iff COMPARE / x : k : [] => 0 : []
- > MEM / x : { Elt k v ; } : S => false : S
- iff COMPARE / x : k : [] => -1 : []
-
-- ``UPDATE``: Assign or remove an element in a map.
-
-::
-
- :: 'key : option 'val : map 'key 'val : 'S -> map 'key 'val : 'S
-
- > UPDATE / x : None : {} : S => {} : S
- > UPDATE / x : Some y : {} : S => { Elt x y } : S
- > UPDATE / x : opt_y : { Elt k v ; } : S => { Elt k v ; } : S
- iff COMPARE / x : k : [] => 1 : []
- where UPDATE / x : opt_y : { } : S => { } : S
- > UPDATE / x : None : { Elt k v ; } : S => { } : S
- iff COMPARE / x : k : [] => 0 : []
- > UPDATE / x : Some y : { Elt k v ; } : S => { Elt k y ; } : S
- iff COMPARE / x : k : [] => 0 : []
- > UPDATE / x : None : { Elt k v ; } : S => { Elt k v ; } : S
- iff COMPARE / x : k : [] => -1 : []
- > UPDATE / x : Some y : { Elt k v ; } : S => { Elt x y ; Elt k v ; } : S
- iff COMPARE / x : k : [] => -1 : []
-
-- ``MAP body``: Apply the body expression to each element of a map. The
- body sequence has access to the stack.
-
-::
-
- :: (map 'key 'val) : 'A -> (map 'key 'b) : 'A
- iff body :: [ (pair 'key 'val) : 'A -> 'b : 'A ]
-
- > MAP body / {} : S => {} : S
- > MAP body / { Elt k v ; } : S => { Elt k (body (Pair k v)) ; } : S
- where MAP body / { } : S => { } : S
-
-- ``ITER body``: Apply the body expression to each element of a map.
- The body sequence has access to the stack.
-
-::
-
- :: (map 'elt 'val) : 'A -> 'A
- iff body :: [ (pair 'elt 'val : 'A) -> 'A ]
-
- > ITER body / {} : S => S
- > ITER body / { Elt k v ; } : S => body ; ITER body / (Pair k v) : { } : S
-
-- ``SIZE``: Get the cardinality of the map.
-
-::
-
- :: map 'key 'val : 'S -> nat : 'S
-
- > SIZE / {} : S => 0 : S
- > SIZE / { _ ; } : S => 1 + s : S
- where SIZE / { } : S => s : S
-
-
-Operations on ``big_maps``
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The behavior of these operations is the same as if they were normal
-maps, except that under the hood, the elements are loaded and
-deserialized on demand.
-
-
-- ``GET``: Access an element in a ``big_map``, returns an optional value to be
- checked with ``IF_SOME``.
-
-::
-
- :: 'key : big_map 'key 'val : 'S -> option 'val : 'S
-
-- ``MEM``: Check for the presence of an element in a ``big_map``.
-
-::
-
- :: 'key : big_map 'key 'val : 'S -> bool : 'S
-
-- ``UPDATE``: Assign or remove an element in a ``big_map``.
-
-::
-
- :: 'key : option 'val : big_map 'key 'val : 'S -> big_map 'key 'val : 'S
-
-
-Operations on optional values
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-- ``SOME``: Pack a present optional value.
-
-::
-
- :: 'a : 'S -> option 'a : 'S
-
- > SOME / v : S => (Some v) : S
-
-- ``NONE 'a``: The absent optional value.
-
-::
-
- :: 'S -> option 'a : 'S
-
- > NONE / v : S => None : S
-
-- ``IF_NONE bt bf``: Inspect an optional value.
-
-::
-
- :: option 'a : 'S -> 'b : 'S
- iff bt :: [ 'S -> 'b : 'S]
- bf :: [ 'a : 'S -> 'b : 'S]
-
- > IF_NONE bt bf / (None) : S => bt / S
- > IF_NONE bt bf / (Some a) : S => bf / a : S
-
-Operations on unions
-~~~~~~~~~~~~~~~~~~~~
-
-- ``LEFT 'b``: Pack a value in a union (left case).
-
-::
-
- :: 'a : 'S -> or 'a 'b : 'S
-
- > LEFT / v : S => (Left v) : S
-
-- ``RIGHT 'a``: Pack a value in a union (right case).
-
-::
-
- :: 'b : 'S -> or 'a 'b : 'S
-
- > RIGHT / v : S => (Right v) : S
-
-- ``IF_LEFT bt bf``: Inspect a value of a union.
-
-::
-
- :: or 'a 'b : 'S -> 'c : 'S
- iff bt :: [ 'a : 'S -> 'c : 'S]
- bf :: [ 'b : 'S -> 'c : 'S]
-
- > IF_LEFT bt bf / (Left a) : S => bt / a : S
- > IF_LEFT bt bf / (Right b) : S => bf / b : S
-
-- ``IF_RIGHT bt bf``: Inspect a value of a union.
-
-::
-
- :: or 'a 'b : 'S -> 'c : 'S
- iff bt :: [ 'b : 'S -> 'c : 'S]
- bf :: [ 'a : 'S -> 'c : 'S]
-
- > IF_RIGHT bt bf / (Right b) : S => bt / b : S
- > IF_RIGHT bt bf / (Left a) : S => bf / a : S
-
-Operations on lists
-~~~~~~~~~~~~~~~~~~~
-
-- ``CONS``: Prepend an element to a list.
-
-::
-
- :: 'a : list 'a : 'S -> list 'a : 'S
-
- > CONS / a : { } : S => { a ; } : S
-
-- ``NIL 'a``: The empty list.
-
-::
-
- :: 'S -> list 'a : 'S
-
- > NIL / S => {} : S
-
-- ``IF_CONS bt bf``: Inspect a list.
-
-::
-
- :: list 'a : 'S -> 'b : 'S
- iff bt :: [ 'a : list 'a : 'S -> 'b : 'S]
- bf :: [ 'S -> 'b : 'S]
-
- > IF_CONS bt bf / { a ; } : S => bt / a : { } : S
- > IF_CONS bt bf / {} : S => bf / S
-
-- ``MAP body``: Apply the body expression to each element of the list.
- The body sequence has access to the stack.
-
-::
-
- :: (list 'elt) : 'A -> (list 'b) : 'A
- iff body :: [ 'elt : 'A -> 'b : 'A ]
-
- > MAP body / { a ; } : S => { body a ; } : S
- where MAP body / { } : S => { } : S
- > MAP body / {} : S => {} : S
-
-- ``SIZE``: Get the number of elements in the list.
-
-::
-
- :: list 'elt : 'S -> nat : 'S
-
- > SIZE / { _ ; } : S => 1 + s : S
- where SIZE / { } : S => s : S
- > SIZE / {} : S => 0 : S
-
-
-- ``ITER body``: Apply the body expression to each element of a list.
- The body sequence has access to the stack.
-
-::
-
- :: (list 'elt) : 'A -> 'A
- iff body :: [ 'elt : 'A -> 'A ]
- > ITER body / { a ; } : S => body ; ITER body / a : { } : S
- > ITER body / {} : S => S
-
-
-VI - Domain specific data types
--------------------------------
-
-- ``timestamp``: Dates in the real world.
-
-- ``mutez``: A specific type for manipulating tokens.
-
-- ``contract 'param``: A contract, with the type of its code.
-
-- ``address``: An untyped contract address.
-
-- ``operation``: An internal operation emitted by a contract.
-
-- ``key``: A public cryptography key.
-
-- ``key_hash``: The hash of a public cryptography key.
-
-- ``signature``: A cryptographic signature.
-
-VII - Domain specific operations
---------------------------------
-
-Operations on timestamps
-~~~~~~~~~~~~~~~~~~~~~~~~
-
-Current Timestamps can be obtained by the ``NOW`` operation, or
-retrieved from script parameters or globals.
-
-- ``ADD`` Increment / decrement a timestamp of the given number of
- seconds.
-
-::
-
- :: timestamp : int : 'S -> timestamp : 'S
- :: int : timestamp : 'S -> timestamp : 'S
-
- > ADD / seconds : nat (t) : S => (seconds + t) : S
- > ADD / nat (t) : seconds : S => (t + seconds) : S
-
-- ``SUB`` Subtract a number of seconds from a timestamp.
-
-::
-
- :: timestamp : int : 'S -> timestamp : 'S
-
- > SUB / seconds : nat (t) : S => (seconds - t) : S
-
-- ``SUB`` Subtract two timestamps.
-
-::
-
- :: timestamp : timestamp : 'S -> int : 'S
-
- > SUB / seconds(t1) : seconds(t2) : S => (t1 - t2) : S
-
-- ``COMPARE``: Timestamp comparison.
-
-::
-
- :: timestamp : timestamp : 'S -> int : 'S
-
- > COMPARE / seconds(t1) : seconds(t2) : S => -1 : S
- iff t1 < t2
- > COMPARE / seconds(t1) : seconds(t2) : S => 0 : S
- iff t1 = t2
- > COMPARE / seconds(t1) : seconds(t2) : S => 1 : S
- iff t1 > t2
-
-
-Operations on Mutez
-~~~~~~~~~~~~~~~~~~~
-
-Mutez (micro-Tez) are internally represented by a 64 bit signed
-integers. There are restrictions to prevent creating a negative amount
-of mutez. Operations are limited to prevent overflow and mixing them
-with other numerical types by mistake. They are also mandatory checked
-for under/overflows.
-
-- ``ADD``:
-
-::
-
- :: mutez : mutez : 'S -> mutez : 'S
-
- > ADD / x : y : S => [FAILED] on overflow
- > ADD / x : y : S => (x + y) : S
-
-- ``SUB``:
-
-::
-
- :: mutez : mutez : 'S -> mutez : 'S
-
- > SUB / x : y : S => [FAILED]
- iff x < y
- > SUB / x : y : S => (x - y) : S
-
-- ``MUL``
-
-::
-
- :: mutez : nat : 'S -> mutez : 'S
- :: nat : mutez : 'S -> mutez : 'S
-
- > MUL / x : y : S => [FAILED] on overflow
- > MUL / x : y : S => (x * y) : S
-
-- ``EDIV``
-
-::
-
- :: mutez : nat : 'S -> option (pair mutez mutez) : 'S
- :: mutez : mutez : 'S -> option (pair nat mutez) : 'S
-
- > EDIV / x : 0 : S => None
- > EDIV / x : y : S => Some (Pair (x / y) (x % y)) : S
- iff y <> 0
-
-- ``COMPARE``
-
-::
-
- :: mutez : mutez : 'S -> int : 'S
-
- > COMPARE / x : y : S => -1 : S
- iff x < y
- > COMPARE / x : y : S => 0 : S
- iff x = y
- > COMPARE / x : y : S => 1 : S
- iff x > y
-
-Operations on contracts
-~~~~~~~~~~~~~~~~~~~~~~~
-
-- ``CREATE_CONTRACT``: Forge a contract creation operation.
-
-::
-
- :: key_hash : option key_hash : bool : bool : mutez : lambda (pair 'p 'g) (pair (list operation) 'g) : 'g : 'S
- -> operation : address : 'S
-
-As with non code-emitted originations the contract code takes as
-argument the transferred amount plus an ad-hoc argument and returns an
-ad-hoc value. The code also takes the global data and returns it to be
-stored and retrieved on the next transaction. These data are initialized
-by another parameter. The calling convention for the code is as follows:
-``(Pair arg globals) -> (Pair operations globals)``, as extrapolated from
-the instruction type. The first parameters are the manager, optional
-delegate, then spendable and delegatable flags and finally the initial
-amount taken from the currently executed contract. The contract is
-returned as a first class value (to be dropped, passed as parameter or stored).
-The ``CONTRACT 'p`` instruction will fail until it is actually originated.
-
-- ``CREATE_CONTRACT { storage 'g ; parameter 'p ; code ... }``:
- Forge a new contract from a literal.
-
-::
-
- :: key_hash : option key_hash : bool : bool : mutez : 'g : 'S
- -> operation : address : 'S
-
-Originate a contract based on a literal. This is currently the only way
-to include transfers inside of an originated contract. The first
-parameters are the manager, optional delegate, then spendable and
-delegatable flags and finally the initial amount taken from the
-currently executed contract.
-
-- ``CREATE_ACCOUNT``: Forge an account (a contract without code) creation operation.
-
-::
-
- :: key_hash : option key_hash : bool : mutez : 'S
- -> operation : address : 'S
-
-Take as argument the manager, optional delegate, the delegatable flag
-and finally the initial amount taken from the currently executed
-contract.
-
-- ``TRANSFER_TOKENS``: Forge a transaction.
-
-::
-
- :: 'p : mutez : contract 'p : 'S -> operation : S
-
-The parameter must be consistent with the one expected by the
-contract, unit for an account.
-
-- ``SET_DELEGATE``: Forge a delegation.
-
-::
-
- :: option key_hash : 'S -> operation : S
-
-- ``BALANCE``: Push the current amount of mutez of the current contract.
-
-::
-
- :: 'S -> mutez : 'S
-
-- ``ADDRESS``: Push the address of a contract.
-
-::
-
- :: contract _ : 'S -> address : 'S
-
-- ``CONTRACT 'p``: Push the untyped version of a contract.
-
-::
-
- :: address : 'S -> option (contract 'p) : 'S
-
- > CONTRACT / addr : S => Some addr : S
- iff addr exists and is a contract of parameter type 'p
- > CONTRACT / addr : S => Some addr : S
- iff 'p = unit and addr is an implicit contract
- > CONTRACT / addr : S => None : S
- otherwise
-
-- ``SOURCE``: Push the contract that initiated the current
- transaction, i.e. the contract that paid the fees and
- storage cost, and whose manager signed the operation
- that was sent on the blockchain. Note that since
- ``TRANSFER_TOKENS`` instructions can be chained,
- ``SOURCE`` and ``SENDER`` are not necessarily the same.
-
-::
-
- :: 'S -> address : 'S
-
-- ``SENDER``: Push the contract that initiated the current
- internal transaction. It may be the ``SOURCE``, but may
- also not if the source sent an order to an intermediate
- smart contract, which then called the current contract.
-
-::
-
- :: 'S -> address : 'S
-
-- ``SELF``: Push the current contract.
-
-::
-
- :: 'S -> contract 'p : 'S
- where contract 'p is the type of the current contract
-
-- ``AMOUNT``: Push the amount of the current transaction.
-
-::
-
- :: 'S -> mutez : 'S
-
-- ``IMPLICIT_ACCOUNT``: Return a default contract with the given
- public/private key pair. Any funds deposited in this contract can
- immediately be spent by the holder of the private key. This contract
- cannot execute Michelson code and will always exist on the
- blockchain.
-
-::
-
- :: key_hash : 'S -> contract unit : 'S
-
-Special operations
-~~~~~~~~~~~~~~~~~~
-
-- ``STEPS_TO_QUOTA``: Push the remaining steps before the contract
- execution must terminate.
-
-::
-
- :: 'S -> nat : 'S
-
-- ``NOW``: Push the timestamp of the block whose validation triggered
- this execution (does not change during the execution of the
- contract).
-
-::
-
- :: 'S -> timestamp : 'S
-
-Operations on bytes
-~~~~~~~~~~~~~~~~~~~
-
-Bytes are used for serializing data, in order to check signatures and
-compute hashes on them. They can also be used to incorporate data from
-the wild and untyped outside world.
-
-- ``PACK``: Serializes a piece of data to its optimized
- binary representation.
-
-::
-
- :: 'a : 'S -> bytes : 'S
-
-- ``UNPACK 'a``: Deserializes a piece of data, if valid.
-
-::
-
- :: bytes : 'S -> option 'a : 'S
-
-- ``CONCAT``: Byte sequence concatenation.
-
-::
-
- :: bytes : bytes : 'S -> bytes : 'S
-
- > CONCAT / s : t : S => (s ^ t) : S
-
- :: bytes list : 'S -> bytes : 'S
-
- > CONCAT / {} : S => 0x : S
- > CONCAT / { s ; } : S => (s ^ r) : S
- where CONCAT / { } : S => r : S
-
-- ``SIZE``: size of a sequence of bytes.
-
-::
-
- :: bytes : 'S -> nat : 'S
-
-- ``SLICE``: Bytes access.
-
-::
-
- :: nat : nat : bytes : 'S -> option bytes : 'S
-
- > SLICE / offset : length : s : S => Some ss : S
- where ss is the substring of s at the given offset and of the given length
- iff offset and (offset + length) are in bounds
- > SLICE / offset : length : s : S => None : S
- iff offset or (offset + length) are out of bounds
-
-- ``COMPARE``: Lexicographic comparison.
-
-::
-
- :: bytes : bytes : 'S -> int : 'S
-
- > COMPARE / s : t : S => -1 : S
- iff s < t
- > COMPARE / s : t : S => 0 : S
- iff s = t
- > COMPARE / s : t : S => 1 : S
- iff s > t
-
-
-Cryptographic primitives
-~~~~~~~~~~~~~~~~~~~~~~~~
-
-- ``HASH_KEY``: Compute the b58check of a public key.
-
-::
-
- :: key : 'S -> key_hash : 'S
-
-- ``BLAKE2B``: Compute a cryptographic hash of the value contents using the
- Blake2B cryptographic hash function.
-
-::
-
- :: bytes : 'S -> bytes : 'S
-
-- ``SHA256``: Compute a cryptographic hash of the value contents using the
- Sha256 cryptographic hash function.
-
-::
-
- :: bytes : 'S -> bytes : 'S
-
-- ``SHA512``: Compute a cryptographic hash of the value contents using the
- Sha512 cryptographic hash function.
-
-::
-
- :: bytes : 'S -> bytes : 'S
-
-- ``CHECK_SIGNATURE``: Check that a sequence of bytes has been signed
- with a given key.
-
-::
-
- :: key : signature : bytes : 'S -> bool : 'S
-
-- ``COMPARE``:
-
-::
-
- :: key_hash : key_hash : 'S -> int : 'S
-
- > COMPARE / x : y : S => -1 : S
- iff x < y
- > COMPARE / x : y : S => 0 : S
- iff x = y
- > COMPARE / x : y : S => 1 : S
- iff x > y
-
-VIII - Macros
--------------
-
-In addition to the operations above, several extensions have been added
-to the language's concrete syntax. If you are interacting with the node
-via RPC, bypassing the client, which expands away these macros, you will
-need to desugar them yourself.
-
-These macros are designed to be unambiguous and reversible, meaning that
-errors are reported in terms of desugared syntax. Below you'll see
-these macros defined in terms of other syntactic forms. That is how
-these macros are seen by the node.
-
-Compare
-~~~~~~~
-
-Syntactic sugar exists for merging ``COMPARE`` and comparison
-combinators, and also for branching.
-
-- ``CMP{EQ|NEQ|LT|GT|LE|GE}``
-
-::
-
- > CMP(\op) / S => COMPARE ; (\op) / S
-
-- ``IF{EQ|NEQ|LT|GT|LE|GE} bt bf``
-
-::
-
- > IF(\op) bt bf / S => (\op) ; IF bt bf / S
-
-- ``IFCMP{EQ|NEQ|LT|GT|LE|GE} bt bf``
-
-::
-
- > IFCMP(\op) / S => COMPARE ; (\op) ; IF bt bf / S
-
-Fail
-~~~~
-
-The ``FAIL`` macros is equivalent to ``UNIT; FAILWITH`` and is callable
-in any context since it does not use its input stack.
-
-- ``FAIL``
-
-::
-
- > FAIL / S => UNIT; FAILWITH / S
-
-Assertion Macros
-~~~~~~~~~~~~~~~~
-
-All assertion operations are syntactic sugar for conditionals with a
-``FAIL`` instruction in the appropriate branch. When possible, use them
-to increase clarity about illegal states.
-
-- ``ASSERT``:
-
-::
-
- > ASSERT => IF {} {FAIL}
-
-- ``ASSERT_{EQ|NEQ|LT|LE|GT|GE}``:
-
-::
-
- > ASSERT_(\op) => IF(\op) {} {FAIL}
-
-- ``ASSERT_CMP{EQ|NEQ|LT|LE|GT|GE}``:
-
-::
-
- > ASSERT_CMP(\op) => IFCMP(\op) {} {FAIL}
-
-- ``ASSERT_NONE``
-
-::
-
- > ASSERT_NONE => IF_NONE {} {FAIL}
-
-- ``ASSERT_SOME``
-
-::
-
- > ASSERT_SOME => IF_NONE {FAIL} {}
-
-- ``ASSERT_LEFT``:
-
-::
-
- > ASSERT_LEFT => IF_LEFT {} {FAIL}
-
-- ``ASSERT_RIGHT``:
-
-::
-
- > ASSERT_RIGHT => IF_LEFT {FAIL} {}
-
-Syntactic Conveniences
-~~~~~~~~~~~~~~~~~~~~~~
-
-These are macros are simply more convenient syntax for various common
-operations.
-
-- ``DII+P code``: A syntactic sugar for working deeper in the stack.
-
-::
-
- > DII(\rest=I*)P code / S => DIP (DI(\rest)P code) / S
-
-- ``DUU+P``: A syntactic sugar for duplicating the ``n``\ th element of
- the stack.
-
-::
-
- > DUU(\rest=U*)P / S => DIP (DU(\rest)P) ; SWAP / S
-
-- ``P(\left=A|P(\left)(\right))(\right=I|P(\left)(\right))R``: A syntactic sugar
- for building nested pairs.
-
-::
-
- > PA(\right)R / S => DIP ((\right)R) ; PAIR / S
- > P(\left)IR / S => PAIR ; (\left)R / S
- > P(\left)(\right)R => (\right)R ; (\left)R ; PAIR / S
-
-A good way to quickly figure which macro to use is to mentally parse the
-macro as ``P`` for pair constructor, ``A`` for left leaf and ``I`` for
-right leaf. The macro takes as many elements on the stack as there are
-leaves and constructs a nested pair with the shape given by its name.
-
-Take the macro ``PAPPAIIR`` for instance:
-
-::
-
- P A P P A I I R
- ( l, ( ( l, r ), r ))
-
-A typing rule can be inferred:
-
-::
-
- PAPPAIIR
- :: 'a : 'b : 'c : 'd : 'S -> (pair 'a (pair (pair 'b 'c) 'd))
-
-- ``UNP(\left=A|P(\left)(\right))(\right=I|P(\left)(\right))R``: A syntactic sugar
- for destructing nested pairs. These macros follow the same convention
- as the previous one.
-
-::
-
- > UNPAIR / S => DUP ; CAR ; DIP { CDR } / S
- > UNPA(\right)R / S => UNPAIR ; DIP (UN(\right)R) / S
- > UNP(\left)IR / S => UNPAIR ; UN(\left)R / S
- > UNP(\left)(\right)R => UNPAIR ; UN(\left)R ; UN(\right)R / S
-
-- ``C[AD]+R``: A syntactic sugar for accessing fields in nested pairs.
-
-::
-
- > CA(\rest=[AD]+)R / S => CAR ; C(\rest)R / S
- > CD(\rest=[AD]+)R / S => CDR ; C(\rest)R / S
-
-- ``IF_SOME bt bf``: Inspect an optional value.
-
-::
-
- :: option 'a : 'S -> 'b : 'S
- iff bt :: [ 'a : 'S -> 'b : 'S]
- bf :: [ 'S -> 'b : 'S]
-
- > IF_SOME / (Some a) : S => bt / a : S
- > IF_SOME / (None) : S => bf / S
-
-- ``SET_CAR``: Set the left field of a pair.
-
-::
-
- > SET_CAR => CDR ; SWAP ; PAIR
-
-- ``SET_CDR``: Set the right field of a pair.
-
-::
-
- > SET_CDR => CAR ; PAIR
-
-- ``SET_C[AD]+R``: A syntactic sugar for setting fields in nested
- pairs.
-
-::
-
- > SET_CA(\rest=[AD]+)R / S =>
- { DUP ; DIP { CAR ; SET_C(\rest)R } ; CDR ; SWAP ; PAIR } / S
- > SET_CD(\rest=[AD]+)R / S =>
- { DUP ; DIP { CDR ; SET_C(\rest)R } ; CAR ; PAIR } / S
-
-- ``MAP_CAR`` code: Transform the left field of a pair.
-
-::
-
- > MAP_CAR code => DUP ; CDR ; DIP { CAR ; code } ; SWAP ; PAIR
-
-- ``MAP_CDR`` code: Transform the right field of a pair.
-
-::
-
- > MAP_CDR code => DUP ; CDR ; code ; SWAP ; CAR ; PAIR
-
-- ``MAP_C[AD]+R`` code: A syntactic sugar for transforming fields in
- nested pairs.
-
-::
-
- > MAP_CA(\rest=[AD]+)R code / S =>
- { DUP ; DIP { CAR ; MAP_C(\rest)R code } ; CDR ; SWAP ; PAIR } / S
- > MAP_CD(\rest=[AD]+)R code / S =>
- { DUP ; DIP { CDR ; MAP_C(\rest)R code } ; CAR ; PAIR } / S
-
-IX - Concrete syntax
---------------------
-
-The concrete language is very close to the formal notation of the
-specification. Its structure is extremely simple: an expression in the
-language can only be one of the four following constructs.
-
-1. An integer.
-2. A character string.
-3. The application of a primitive to a sequence of expressions.
-4. A sequence of expressions.
-
-This simple four cases notation is called Micheline.
-
-The encoding of a Micheline source file must be UTF-8, and non-ASCII
-characters can only appear in comments and strings.
-
-Constants
-~~~~~~~~~
-
-There are three kinds of constants:
-
-1. Integers or naturals in decimal notation.
-2. Strings, with usual escape sequences: ``\n``, ``\t``, ``\b``,
- ``\r``, ``\\``, ``\"``. Unescaped line-breaks (both ``\n`` and ``\r``)
- cannot appear in the middle of a string.
-3. Byte sequences in hexadecimal notation, prefixed with ``0x``.
-
-The current version of Michelson restricts strings to be the printable
-subset of 7-bit ASCII, plus the escaped characters mentioned above.
-
-Primitive applications
-~~~~~~~~~~~~~~~~~~~~~~
-
-A primitive application is a name followed by arguments
-
-::
-
- prim arg1 arg2
-
-When a primitive application is the argument to another primitive
-application, it must be wrapped with parentheses.
-
-::
-
- prim (prim1 arg11 arg12) (prim2 arg21 arg22)
-
-Sequences
-~~~~~~~~~
-
-Successive expression can be grouped as a single sequence expression
-using curly braces as delimiters and semicolon as separators.
-
-::
-
- { expr1 ; expr2 ; expr3 ; expr4 }
-
-A sequence can be passed as argument to a primitive.
-
-::
-
- prim arg1 arg2 { arg3_expr1 ; arg3_expr2 }
-
-Primitive applications right inside a sequence cannot be wrapped.
-
-::
-
- { (prim arg1 arg2) } # is not ok
-
-Indentation
-~~~~~~~~~~~
-
-To remove ambiguities for human readers, the parser enforces some
-indentation rules.
-
-- For sequences:
-
- - All expressions in a sequence must be aligned on the same column.
- - An exception is made when consecutive expressions fit on the same
- line, as long as the first of them is correctly aligned.
- - All expressions in a sequence must be indented to the right of the
- opening curly brace by at least one column.
- - The closing curly brace cannot be on the left of the opening one.
-
-- For primitive applications:
-
- - All arguments in an application must be aligned on the same
- column.
- - An exception is made when consecutive arguments fit on the same
- line, as long as the first of them is correctly aligned.
- - All arguments in a sequence must be indented to the right of the
- primitive name by at least one column.
-
-Differences with the formal notation
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The concrete syntax follows the same lexical conventions as the
-specification: instructions are represented by uppercase identifiers,
-type constructors by lowercase identifiers, and constant constructors
-are Capitalized.
-
-All domain specific constants are Micheline constants with specific
-formats. Some have two variants accepted by the data type checker: a
-readable one in a string and an optimized.
-
-- ``mutez`` amounts are written as naturals.
-- ``timestamp``\ s are written either using ``RFC3339`` notation
- in a string (readable), or as the number of seconds since Epoch
- in a natural (optimized).
-- ``contract``\ s, ``address``\ es, ``key``\ s and ``signature``\ s
- are written as strings, in their usual Base58 encoded versions
- (readable), or as their raw bytes (optimized).
-
-The optimized versions should not reach the RPCs, the protocol code
-will convert to optimized by itself when forging operations, storing
-to the database, and before hashing to get a canonical representation
-of a datum for a given type.
-
-To prevent errors, control flow primitives that take instructions as
-parameters require sequences in the concrete syntax.
-
-::
-
- IF { instr1_true ; instr2_true ; ... }
- { instr1_false ; instr2_false ; ... }
-
-Main program structure
-~~~~~~~~~~~~~~~~~~~~~~
-
-The toplevel of a smart contract file must be an un-delimited sequence
-of four primitive applications (in no particular order) that provide its
-``code``, ``parameter`` and ``storage`` fields.
-
-See the next section for a concrete example.
-
-Comments
-~~~~~~~~
-
-A hash sign (``#``) anywhere outside of a string literal will make the
-rest of the line (and itself) completely ignored, as in the following
-example.
-
-::
-
- { PUSH nat 1 ; # pushes 1
- PUSH nat 2 ; # pushes 2
- ADD } # computes 2 + 1
-
-Comments that span on multiple lines or that stop before the end of the
-line can also be written, using C-like delimiters (``/* ... */``).
-
-X - Annotations
----------------
-
-The annotation mechanism of Michelson provides ways to better track data
-on the stack and to give additional type constraints. Annotations are
-only here to add constraints, *i.e.* they cannot turn an otherwise
-rejected program into an accepted one.
-
-Stack visualization tools like the Michelson's Emacs mode print
-annotations associated with each type in the program, as propagated by
-the typechecker as well as variable annotations on the types of elements
-in the stack. This is useful as a debugging aid.
-
-We distinguish three kinds of annotations:
-- type annotations, written ``:type_annot``,
-- variable annotations, written ``@var_annot``,
-- and field or constructors annotations, written ``%field_annot``.
-
-Type Annotations
-~~~~~~~~~~~~~~~~
-
-Each type can be annotated with at most one type annotation. They are
-used to give names to types. For types to be equal, their unnamed
-version must be equal and their names must be the same or at least one
-type must be unnamed.
-
-For instance, the following Michelson program which put its integer
-parameter in the storage is not well typed:
-
-::
-
- parameter (int :p) ;
- storage (int :s) ;
- code { UNPAIR ; SWAP ; DROP ; NIL operation ; PAIR }
-
-Whereas this one is:
-
-::
-
- parameter (int :p) ;
- storage int ;
- code { UNPAIR ; SWAP ; DROP ; NIL operation ; PAIR }
-
-Inner components of composed typed can also be named.
-
-::
-
- (pair :point (int :x_pos) (int :y_pos))
-
-Push-like instructions, that act as constructors, can also be given a
-type annotation. The stack type will then have a correspondingly named
-type on top.
-
-::
-
- UNIT :t
- :: 'A -> (unit :t) : 'A
-
- PAIR :t
- :: 'a : 'b : 'S -> (pair :t 'a 'b) : 'S
-
- SOME :t
- :: 'a : 'S -> (option :t 'a) : 'S
-
- NONE :t 'a
- :: 'S -> (option :t 'a) : 'S
-
- LEFT :t 'b
- :: 'a : 'S -> (or :t 'a 'b) : 'S
-
- RIGHT :t 'a
- :: 'b : 'S -> (or :t 'a 'b) : 'S
-
- NIL :t 'a
- :: 'S -> (list :t 'a) : 'S
-
- EMPTY_SET :t 'elt
- :: 'S -> (set :t 'elt) : 'S
-
- EMPTY_MAP :t 'key 'val
- :: 'S -> (map :t 'key 'val) : 'S
-
-
-A no-op instruction ``CAST`` ensures the top of the stack has the
-specified type, and change its type if it is compatible. In particular,
-this allows to change or remove type names explicitly.
-
-::
-
- CAST 'b
- :: 'a : 'S -> 'b : 'S
- iff 'a = 'b
-
- > CAST t / a : S => a : S
-
-
-Variable Annotations
-~~~~~~~~~~~~~~~~~~~~
-
-Variable annotations can only be used on instructions that produce
-elements on the stack. An instruction that produces ``n`` elements on
-the stack can be given at most ``n`` variable annotations.
-
-The stack type contains both the types of each element in the stack, as
-well as an optional variable annotation for each element. In this
-sub-section we note:
-- ``[]`` for the empty stack ;
-- ``@annot (top) : (rest)`` for the stack whose first value has type ``(top)`` and is annotated with variable annotation ``@annot`` and whose queue has stack type ``(rest)``.
-
-The instructions which do not accept any variable annotations are:
-
-::
-
- DROP
- SWAP
- IF_NONE
- IF_LEFT
- IF_CONS
- ITER
- IF
- LOOP
- LOOP_LEFT
- DIP
- FAILWITH
-
-The instructions which accept at most one variable annotation are:
-
-::
-
- DUP
- PUSH
- UNIT
- SOME
- NONE
- PAIR
- CAR
- CDR
- LEFT
- RIGHT
- NIL
- CONS
- SIZE
- MAP
- MEM
- EMPTY_SET
- EMPTY_MAP
- UPDATE
- GET
- LAMBDA
- EXEC
- ADD
- SUB
- CONCAT
- MUL
- OR
- AND
- XOR
- NOT
- ABS
- IS_NAT
- INT
- NEG
- EDIV
- LSL
- LSR
- COMPARE
- EQ
- NEQ
- LT
- GT
- LE
- GE
- ADDRESS
- CONTRACT
- SET_DELEGATE
- IMPLICIT_ACCOUNT
- NOW
- AMOUNT
- BALANCE
- HASH_KEY
- CHECK_SIGNATURE
- BLAKE2B
- STEPS_TO_QUOTA
- SOURCE
- SENDER
- SELF
- CAST
- RENAME
-
-The instructions which accept at most two variable annotations are:
-
-::
-
- CREATE_ACCOUNT
- CREATE_CONTRACT
-
-Annotations on instructions that produce multiple elements on the stack
-will be used in order, where the first variable annotation is given to
-the top-most element on the resulting stack. Instructions that produce
-``n`` elements on the stack but are given less than ``n`` variable
-annotations will see only their top-most stack type elements annotated.
-
-::
-
- CREATE_ACCOUNT @op @addr
- :: key_hash : option key_hash : bool : mutez : 'S
- -> @op operation : @addr address : 'S
-
- CREATE_ACCOUNT @op
- :: key_hash : option key_hash : bool : mutez : 'S
- -> @op operation : address : 'S
-
-A no-op instruction ``RENAME`` allows to rename variables in the stack
-or to erase variable annotations in the stack.
-
-::
-
- RENAME @new
- :: @old 'a ; 'S -> @new 'a : 'S
-
- RENAME
- :: @old 'a ; 'S -> 'a : 'S
-
-
-Field and Constructor Annotations
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Components of pair types, option types and or types can be annotated
-with a field or constructor annotation. This feature is useful to encode
-records fields and constructors of sum types.
-
-::
-
- (pair :point
- (int %x)
- (int %y))
-
-The previous Michelson type can be used as visual aid to represent the
-record type (given in OCaml-like syntax):
-
-::
-
- type point = { x : int ; y : int }
-
-Similarly,
-
-::
-
- (or :t
- (int %A)
- (or
- (bool %B)
- (pair %C
- (nat %n1)
- (nat %n2))))
-
-can be used to represent the algebraic data type (in OCaml-like syntax):
-
-::
-
- type t =
- | A of int
- | B of bool
- | C of { n1 : nat ; n2 : nat }
-
-
-Field annotations are part of the type (at the same level as type name
-annotations), and so types with differing field names (if present) are
-not considered equal.
-
-Instructions that construct elements of composed types can also be
-annotated with one or multiple field annotations (in addition to type
-and variable annotations).
-
-::
-
- PAIR %fst %snd
- :: 'a : 'b : 'S -> (pair ('a %fst) ('b %snd)) : 'S
-
- LEFT %left %right 'b
- :: 'a : 'S -> (or ('a %left) ('b %right)) : 'S
-
- RIGHT %left %right 'a
- :: 'b : 'S -> (or ('a %left) ('b %right)) : 'S
-
- NONE %some 'a
- :: 'S -> (option ('a %some))
-
- Some %some
- :: 'a : 'S -> (option ('a %some))
-
-To improve readability and robustness, instructions ``CAR`` and ``CDR``
-accept one field annotation. For the contract to type check, the name of
-the accessed field in the destructed pair must match the one given here.
-
-::
-
- CAR %fst
- :: (pair ('a %fst) 'b) : S -> 'a : 'S
-
- CDR %snd
- :: (pair 'a ('b %snd)) : S -> 'b : 'S
-
-
-Syntax
-~~~~~~
-
-Primitive applications can receive one or many annotations.
-
-An annotation is a sequence of characters that matches the regular
-expression ``[@:%](|@|%|%%|[_a-zA-Z][_0-9a-zA-Z\.]*)``. They come after
-the primitive name and before its potential arguments.
-
-::
-
- (prim @v :t %x arg1 arg2 ...)
-
-
-Ordering between different kinds of annotations is not significant, but
-ordering among annotations of the same kind is. Annotations of a same
-kind must be grouped together.
-
-For instance these two annotated instructions are equivalent:
-
-::
-
- PAIR :t @my_pair %x %y
-
- PAIR %x %y :t @my_pair
-
-An annotation can be empty, in this case is will mean *no annotation*
-and can be used as a wildcard. For instance, it is useful to annotate
-only the right field of a pair instruction ``PAIR % %right`` or to
-ignore field access constraints, *e.g.* in the macro ``UNPPAIPAIR %x1 %
-%x3 %x4``.
-
-Annotations and Macros
-~~~~~~~~~~~~~~~~~~~~~~
-
-Macros also support annotations, which are propagated on their expanded
-forms. As with instructions, macros that produce ``n`` values on the
-stack accept ``n`` variable annotations.
-
-::
-
- DUU+P @annot
- > DUU(\rest=U*)P @annot / S => DIP (DU(\rest)P @annot) ; SWAP / S
-
- C[AD]+R @annot %field_name
- > CA(\rest=[AD]+)R @annot %field_name / S => CAR ; C(\rest)R @annot %field_name / S
- > CD(\rest=[AD]+)R @annot %field_name / S => CDR ; C(\rest)R @annot %field_name / S
-
- ``CMP{EQ|NEQ|LT|GT|LE|GE}`` @annot
- > CMP(\op) @annot / S => COMPARE ; (\op) @annot / S
-
-The variable annotation on ``SET_C[AD]+R`` and ``MAP_C[AD]+R`` annotates
-the resulting toplevel pair while its field annotation is used to check
-that the modified field is the expected one.
-
-::
-
- SET_C[AD]+R @var %field
- > SET_CAR @var %field => CDR %field ; SWAP ; PAIR @var
- > SET_CDR @var %field => CAR %field ; PAIR @var
- > SET_CA(\rest=[AD]+)R @var %field / S =>
- { DUP ; DIP { CAR ; SET_C(\rest)R %field } ; CDR ; SWAP ; PAIR @var } / S
- > SET_CD(\rest=[AD]+)R @var %field/ S =>
- { DUP ; DIP { CDR ; SET_C(\rest)R %field } ; CAR ; PAIR @var } / S
-
- MAP_C[AD]+R @var %field code
- > MAP_CAR code => DUP ; CDR ; DIP { CAR %field ; code } ; SWAP ; PAIR @var
- > MAP_CDR code => DUP ; CDR %field ; code ; SWAP ; CAR ; PAIR @var
- > MAP_CA(\rest=[AD]+)R @var %field code / S =>
- { DUP ; DIP { CAR ; MAP_C(\rest)R %field code } ; CDR ; SWAP ; PAIR @var} / S
- > MAP_CD(\rest=[AD]+)R @var %field code / S =>
- { DUP ; DIP { CDR ; MAP_C(\rest)R %field code } ; CAR ; PAIR @var} / S
-
-Macros for nested ``PAIR`` and ``UNPAIR`` accept multiple
-annotations. Field annotations for ``PAIR`` give names to leaves of the
-constructed nested pair, in order. Variable annotations for ``UNPAIR``
-give names to deconstructed components on the stack. This next snippet
-gives examples instead of generic rewrite rules for readability
-purposes.
-
-::
-
- PAPPAIIR @p %x1 %x2 %x3 %x4
- :: 'a : 'b : 'c : 'd : 'S
- -> @p (pair ('a %x1) (pair (pair ('b %x) ('c %x3)) ('d %x4))) : 'S
-
- PAPAIR @p %x1 %x2 %x3
- :: 'a : 'b : 'c : 'S -> @p (pair ('a %x1) (pair ('b %x) ('c %x3))) : 'S
-
- UNPAIR @x @y
- :: (pair 'a 'b) : 'S -> @x 'a : @y 'b : 'S
-
- UNPAPPAIIR @x1 @x2 @x3 @x4
- :: (pair 'a (pair (pair 'b 'c) 'd )) : 'S
- -> @x1 'a : @x2 'b : @x3 'c : @x4 'd : 'S
-
-Automatic Variable and Field Annotations Inferring
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-When no annotation is provided by the Michelson programmer, the
-typechecker infers some annotations in specific cases. This greatly
-helps users track information in the stack for bare contracts.
-
-For unannotated accesses with ``CAR`` and ``CDR`` to fields that are
-named will be appended (with an additional ``.`` character) to the pair
-variable annotation.
-
-::
-
- CDAR
- :: @p (pair ('a %foo) (pair %bar ('b %x) ('c %y))) : 'S -> @p.bar.x 'b : 'S
-
-If fields are not named but the pair is still named in the stack then
-``.car`` or ``.cdr`` will be appended.
-
-::
-
- CDAR
- :: @p (pair 'a (pair 'b 'c)) : 'S -> @p.cdr.car 'b : 'S
-
-If the original pair is not named in the stack, but a field annotation
-is present in the pair type the accessed value will be annotated with a
-variable annotation corresponding to the field annotation alone.
-
-::
-
- CDAR
- :: (pair ('a %foo) (pair %bar ('b %x) ('c %y))) : 'S -> @bar.x 'b : 'S
-
-A similar mechanism is used for context dependent instructions:
-
-::
-
- ADDRESS :: @c contract _ : 'S -> @c.address address : 'S
-
- CONTRACT 'p :: @a address : 'S -> @a.contract contract 'p : 'S
-
- BALANCE :: 'S -> @balance mutez : 'S
-
- SOURCE :: 'S -> @source address : 'S
-
- SENDER :: 'S -> @sender address : 'S
-
- SELF :: 'S -> @self contract 'p : 'S
-
- AMOUNT :: 'S -> @amount mutez : 'S
-
- STEPS_TO_QUOTA :: 'S -> @steps nat : 'S
-
- NOW :: 'S -> @now timestamp : 'S
-
-Inside nested code blocks, bound items on the stack will be given a
-default variable name annotation depending on the instruction and stack
-type (which can be changed). For instance the annotated typing rule for
-``ITER`` on lists is:
-
-::
-
- ITER body
- :: @l (list 'e) : 'A -> 'A
- iff body :: [ @l.elt e' : 'A -> 'A ]
-
-Special Annotations
-~~~~~~~~~~~~~~~~~~~
-
-The special variable annotations ``@%%`` can be used on instructions
-``CAR`` and ``CDR``. It means to use the accessed field name (if any) as
-a name for the value on the stack. The following typing rule
-demonstrates their use for instruction ``CAR``.
-
-::
-
- CAR @%
- :: @p (pair ('a %fst) ('b %snd)) : 'S -> @fst 'a : 'S
-
- CAR @%%
- :: @p (pair ('a %fst) ('b %snd)) : 'S -> @p.fst 'a : 'S
-
-The special variable annotation ``%@`` can be used on instructions
-``PAIR``, ``SOME``, ``LEFT``, ``RIGHT``. It means to use the variable
-name annotation in the stack as a field name for the constructed
-element. Two examples with ``PAIR`` follows, notice the special
-treatment of annotations with `.`.
-
-::
-
- PAIR %@ %@
- :: @x 'a : @y 'b : 'S -> (pair ('a %x) ('b %y)) : 'S
-
- PAIR %@ %@
- :: @p.x 'a : @p.y 'b : 'S -> @p (pair ('a %x) ('b %y)) : 'S
- :: @p.x 'a : @q.y 'b : 'S -> (pair ('a %x) ('b %y)) : 'S
-
-XI - JSON syntax
-----------------
-
-Micheline expressions are encoded in JSON like this:
-
-- An integer ``N`` is an object with a single field ``"int"`` whose
- value is the decimal representation as a string.
-
- ``{ "int": "N" }``
-
-- A string ``"contents"`` is an object with a single field ``"string"``
- whose value is the decimal representation as a string.
-
- ``{ "string": "contents" }``
-
-- A sequence is a JSON array.
-
- ``[ expr, ... ]``
-
-- A primitive application is an object with two fields ``"prim"`` for
- the primitive name and ``"args"`` for the arguments (that must
- contain an array). A third optional field ``"annots"`` contains a
- list of annotations, including their leading ``@``, ``%`` or ``%``
- sign.
-
- ``{ "prim": "pair", "args": [ { "prim": "nat", "args": [] }, { "prim": "nat", "args": [] } ], "annots": [":t"] }``
-
-As in the concrete syntax, all domain specific constants are encoded as
-strings.
-
-XII - Examples
---------------
-
-Contracts in the system are stored as a piece of code and a global data
-storage. The type of the global data of the storage is fixed for each
-contract at origination time. This is ensured statically by checking on
-origination that the code preserves the type of the global data. For
-this, the code of the contract is checked to be of type
-``lambda (pair 'arg 'global) -> (pair (list operation) 'global)`` where
-``'global`` is the type of the original global store given on origination.
-The contract also takes a parameter and returns a list of internal operations,
-hence the complete calling convention above. The internal operations are
-queued for execution when the contract returns.
-
-Empty contract
-~~~~~~~~~~~~~~
-
-The simplest contract is the contract for which the ``parameter`` and
-``storage`` are all of type ``unit``. This contract is as follows:
-
-::
-
- code { CDR ; # keep the storage
- NIL operation ; # return no internal operation
- PAIR }; # respect the calling convention
- storage unit;
- parameter unit;
-
-Reservoir contract
-~~~~~~~~~~~~~~~~~~
-
-We want to create a contract that stores tez until a timestamp ``T`` or
-a maximum amount ``N`` is reached. Whenever ``N`` is reached before
-``T``, all tokens are reversed to an account ``B`` (and the contract is
-automatically deleted). Any call to the contract's code performed after
-``T`` will otherwise transfer the tokens to another account ``A``.
-
-We want to build this contract in a reusable manner, so we do not
-hard-code the parameters. Instead, we assume that the global data of the
-contract are ``(Pair (Pair T N) (Pair A B))``.
-
-Hence, the global data of the contract has the following type
-
-::
-
- 'g =
- pair
- (pair timestamp mutez)
- (pair (contract unit) (contract unit))
-
-Following the contract calling convention, the code is a lambda of type
-
-::
-
- lambda
- (pair unit 'g)
- (pair (list operation) 'g)
-
-written as
-
-::
-
- lambda
- (pair
- unit
- (pair
- (pair timestamp mutez)
- (pair (contract unit) (contract unit))))
- (pair
- (list operation)
- (pair
- (pair timestamp mutez)
- (pair (contract unit) (contract unit))))
-
-The complete source ``reservoir.tz`` is:
-
-::
-
- parameter unit ;
- storage
- (pair
- (pair (timestamp %T) (mutez %N)) # T N
- (pair (contract %A unit) (contract %B unit))) ; # A B
- code
- { CDR ; DUP ; CAAR %T; # T
- NOW ; COMPARE ; LE ;
- IF { DUP ; CADR %N; # N
- BALANCE ;
- COMPARE ; LE ;
- IF { NIL operation ; PAIR }
- { DUP ; CDDR %B; # B
- BALANCE ; UNIT ;
- TRANSFER_TOKENS ;
- NIL operation ; SWAP ; CONS ;
- PAIR } }
- { DUP ; CDAR %A; # A
- BALANCE ;
- UNIT ;
- TRANSFER_TOKENS ;
- NIL operation ; SWAP ; CONS ;
- PAIR } }
-
-Reservoir contract (variant with broker and status)
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-We basically want the same contract as the previous one, but instead of
-leaving it empty, we want to keep it alive, storing a flag ``S`` so that we
-can tell afterwards if the tokens have been transferred to ``A`` or
-``B``. We also want a broker ``X`` to get some fee ``P`` in any case.
-
-We thus add variables ``P`` and ``S`` and ``X`` to the global data of
-the contract, now
-``(Pair (S, Pair (T, Pair (Pair P N) (Pair X (Pair A B)))))``. ``P`` is
-the fee for broker ``A``, ``S`` is the state, as a string ``"open"``,
-``"timeout"`` or ``"success"``.
-
-At the beginning of the transaction:
-
-::
-
- S is accessible via a CDAR
- T via a CDDAR
- P via a CDDDAAR
- N via a CDDDADR
- X via a CDDDDAR
- A via a CDDDDDAR
- B via a CDDDDDDR
-
-The complete source ``scrutable_reservoir.tz`` is:
-
-::
-
- parameter unit ;
- storage
- (pair
- string # S
- (pair
- timestamp # T
- (pair
- (pair mutez mutez) # P N
- (pair
- (contract unit) # X
- (pair (contract unit) (contract unit)))))) ; # A B
- code
- { DUP ; CDAR ; # S
- PUSH string "open" ;
- COMPARE ; NEQ ;
- IF { FAIL } # on "success", "timeout" or a bad init value
- { DUP ; CDDAR ; # T
- NOW ;
- COMPARE ; LT ;
- IF { # Before timeout
- # We compute (P + N) mutez
- PUSH mutez 0 ;
- DIP { DUP ; CDDDAAR } ; ADD ; # P
- DIP { DUP ; CDDDADR } ; ADD ; # N
- # We compare to the cumulated amount
- BALANCE ;
- COMPARE; LT ;
- IF { # Not enough cash, we just accept the transaction
- # and leave the global untouched
- CDR ; NIL operation ; PAIR }
- { # Enough cash, successful ending
- # We update the global
- CDDR ; PUSH string "success" ; PAIR ;
- # We transfer the fee to the broker
- DUP ; CDDAAR ; # P
- DIP { DUP ; CDDDAR } ; # X
- UNIT ; TRANSFER_TOKENS ;
- # We transfer the rest to A
- DIP { DUP ; CDDADR ; # N
- DIP { DUP ; CDDDDAR } ; # A
- UNIT ; TRANSFER_TOKENS } ;
- NIL operation ; SWAP ; CONS ; SWAP ; CONS ;
- PAIR } }
- { # After timeout, we refund
- # We update the global
- CDDR ; PUSH string "timeout" ; PAIR ;
- # We try to transfer the fee to the broker
- BALANCE ; # available
- DIP { DUP ; CDDAAR } ; # P
- COMPARE ; LT ; # available < P
- IF { BALANCE ; # available
- DIP { DUP ; CDDDAR } ; # X
- UNIT ; TRANSFER_TOKENS }
- { DUP ; CDDAAR ; # P
- DIP { DUP ; CDDDAR } ; # X
- UNIT ; TRANSFER_TOKENS } ;
- # We transfer the rest to B
- DIP { BALANCE ; # available
- DIP { DUP ; CDDDDDR } ; # B
- UNIT ; TRANSFER_TOKENS } ;
- NIL operation ; SWAP ; CONS ; SWAP ; CONS ;
- PAIR } } }
-
-Forward contract
-~~~~~~~~~~~~~~~~
-
-We want to write a forward contract on dried peas. The contract takes as
-global data the tons of peas ``Q``, the expected delivery date ``T``,
-the contract agreement date ``Z``, a strike ``K``, a collateral ``C``
-per ton of dried peas, and the accounts of the buyer ``B``, the seller
-``S`` and the warehouse ``W``.
-
-These parameters as grouped in the global storage as follows:
-
-::
-
- Pair
- (Pair (Pair Q (Pair T Z)))
- (Pair
- (Pair K C)
- (Pair (Pair B S) W))
-
-of type
-
-::
-
- pair
- (pair nat (pair timestamp timestamp))
- (pair
- (pair mutez mutez)
- (pair (pair account account) account))
-
-The 24 hours after timestamp ``Z`` are for the buyer and seller to store
-their collateral ``(Q * C)``. For this, the contract takes a string as
-parameter, matching ``"buyer"`` or ``"seller"`` indicating the party for
-which the tokens are transferred. At the end of this day, each of them
-can send a transaction to send its tokens back. For this, we need to
-store who already paid and how much, as a ``(pair mutez mutez)`` where the
-left component is the buyer and the right one the seller.
-
-After the first day, nothing can happen until ``T``.
-
-During the 24 hours after ``T``, the buyer must pay ``(Q * K)`` to the
-contract, minus the amount already sent.
-
-After this day, if the buyer didn't pay enough then any transaction will
-send all the tokens to the seller.
-
-Otherwise, the seller must deliver at least ``Q`` tons of dried peas to
-the warehouse, in the next 24 hours. When the amount is equal to or
-exceeds ``Q``, all the tokens are transferred to the seller.
-For storing the quantity of peas already
-delivered, we add a counter of type ``nat`` in the global storage. For
-knowing this quantity, we accept messages from W with a partial amount
-of delivered peas as argument.
-
-After this day, any transaction will send all the tokens to the buyer
-(not enough peas have been delivered in time).
-
-Hence, the global storage is a pair, with the counters on the left, and
-the constant parameters on the right, initially as follows.
-
-::
-
- Pair
- (Pair 0 (Pair 0_00 0_00))
- (Pair
- (Pair (Pair Q (Pair T Z)))
- (Pair
- (Pair K C)
- (Pair (Pair B S) W)))
-
-of type
-
-::
-
- pair
- (pair nat (pair mutez mutez))
- (pair
- (pair nat (pair timestamp timestamp))
- (pair
- (pair mutez mutez)
- (pair (pair account account) account)))
-
-The parameter of the transaction will be either a transfer from the
-buyer or the seller or a delivery notification from the warehouse of
-type ``(or string nat)``.
-
-At the beginning of the transaction:
-
-::
-
- Q is accessible via a CDDAAR
- T via a CDDADAR
- Z via a CDDADDR
- K via a CDDDAAR
- C via a CDDDADR
- B via a CDDDDAAR
- S via a CDDDDADR
- W via a CDDDDDR
- the delivery counter via a CDAAR
- the amount versed by the seller via a CDADDR
- the argument via a CAR
-
-The complete source ``forward.tz`` is:
-
-::
-
- parameter
- (or string nat) ;
- storage
- (pair
- (pair nat (pair mutez mutez)) # counter from_buyer from_seller
- (pair
- (pair nat (pair timestamp timestamp)) # Q T Z
- (pair
- (pair mutez mutez) # K C
- (pair
- (pair (contract unit) (contract unit)) # B S
- (contract unit))))) ; # W
- code
- { DUP ; CDDADDR ; # Z
- PUSH int 86400 ; SWAP ; ADD ; # one day in second
- NOW ; COMPARE ; LT ;
- IF { # Before Z + 24
- DUP ; CAR ; # we must receive (Left "buyer") or (Left "seller")
- IF_LEFT
- { DUP ; PUSH string "buyer" ; COMPARE ; EQ ;
- IF { DROP ;
- DUP ; CDADAR ; # amount already versed by the buyer
- DIP { AMOUNT } ; ADD ; # transaction
- # then we rebuild the globals
- DIP { DUP ; CDADDR } ; PAIR ; # seller amount
- PUSH nat 0 ; PAIR ; # delivery counter at 0
- DIP { CDDR } ; PAIR ; # parameters
- # and return Unit
- NIL operation ; PAIR }
- { PUSH string "seller" ; COMPARE ; EQ ;
- IF { DUP ; CDADDR ; # amount already versed by the seller
- DIP { AMOUNT } ; ADD ; # transaction
- # then we rebuild the globals
- DIP { DUP ; CDADAR } ; SWAP ; PAIR ; # buyer amount
- PUSH nat 0 ; PAIR ; # delivery counter at 0
- DIP { CDDR } ; PAIR ; # parameters
- # and return Unit
- NIL operation ; PAIR }
- { FAIL } } } # (Left _)
- { FAIL } } # (Right _)
- { # After Z + 24
- # if balance is emptied, just fail
- BALANCE ; PUSH mutez 0 ; IFCMPEQ { FAIL } {} ;
- # test if the required amount is reached
- DUP ; CDDAAR ; # Q
- DIP { DUP ; CDDDADR } ; MUL ; # C
- PUSH nat 2 ; MUL ;
- BALANCE ; COMPARE ; LT ; # balance < 2 * (Q * C)
- IF { # refund the parties
- CDR ; DUP ; CADAR ; # amount versed by the buyer
- DIP { DUP ; CDDDAAR } ; # B
- UNIT ; TRANSFER_TOKENS ;
- NIL operation ; SWAP ; CONS ; SWAP ;
- DUP ; CADDR ; # amount versed by the seller
- DIP { DUP ; CDDDADR } ; # S
- UNIT ; TRANSFER_TOKENS ; SWAP ;
- DIP { CONS } ;
- DUP ; CADAR ; DIP { DUP ; CADDR } ; ADD ;
- BALANCE ; SUB ; # bonus to the warehouse
- DIP { DUP ; CDDDDR } ; # W
- UNIT ; TRANSFER_TOKENS ;
- DIP { SWAP } ; CONS ;
- # leave the storage as-is, as the balance is now 0
- PAIR }
- { # otherwise continue
- DUP ; CDDADAR ; # T
- NOW ; COMPARE ; LT ;
- IF { FAIL } # Between Z + 24 and T
- { # after T
- DUP ; CDDADAR ; # T
- PUSH int 86400 ; ADD ; # one day in second
- NOW ; COMPARE ; LT ;
- IF { # Between T and T + 24
- # we only accept transactions from the buyer
- DUP ; CAR ; # we must receive (Left "buyer")
- IF_LEFT
- { PUSH string "buyer" ; COMPARE ; EQ ;
- IF { DUP ; CDADAR ; # amount already versed by the buyer
- DIP { AMOUNT } ; ADD ; # transaction
- # The amount must not exceed Q * K
- DUP ;
- DIIP { DUP ; CDDAAR ; # Q
- DIP { DUP ; CDDDAAR } ; MUL ; } ; # K
- DIP { COMPARE ; GT ; # new amount > Q * K
- IF { FAIL } { } } ; # abort or continue
- # then we rebuild the globals
- DIP { DUP ; CDADDR } ; PAIR ; # seller amount
- PUSH nat 0 ; PAIR ; # delivery counter at 0
- DIP { CDDR } ; PAIR ; # parameters
- # and return Unit
- NIL operation ; PAIR }
- { FAIL } } # (Left _)
- { FAIL } } # (Right _)
- { # After T + 24
- # test if the required payment is reached
- DUP ; CDDAAR ; # Q
- DIP { DUP ; CDDDAAR } ; MUL ; # K
- DIP { DUP ; CDADAR } ; # amount already versed by the buyer
- COMPARE ; NEQ ;
- IF { # not reached, pay the seller
- BALANCE ;
- DIP { DUP ; CDDDDADR } ; # S
- DIIP { CDR } ;
- UNIT ; TRANSFER_TOKENS ;
- NIL operation ; SWAP ; CONS ; PAIR }
- { # otherwise continue
- DUP ; CDDADAR ; # T
- PUSH int 86400 ; ADD ;
- PUSH int 86400 ; ADD ; # two days in second
- NOW ; COMPARE ; LT ;
- IF { # Between T + 24 and T + 48
- # We accept only delivery notifications, from W
- DUP ; CDDDDDR ; ADDRESS ; # W
- SENDER ;
- COMPARE ; NEQ ;
- IF { FAIL } {} ; # fail if not the warehouse
- DUP ; CAR ; # we must receive (Right amount)
- IF_LEFT
- { FAIL } # (Left _)
- { # We increment the counter
- DIP { DUP ; CDAAR } ; ADD ;
- # And rebuild the globals in advance
- DIP { DUP ; CDADR } ; PAIR ;
- DIP { CDDR } ; PAIR ;
- UNIT ; PAIR ;
- # We test if enough have been delivered
- DUP ; CDAAR ;
- DIP { DUP ; CDDAAR } ;
- COMPARE ; LT ; # counter < Q
- IF { CDR ; NIL operation } # wait for more
- { # Transfer all the money to the seller
- BALANCE ;
- DIP { DUP ; CDDDDADR } ; # S
- DIIP { CDR } ;
- UNIT ; TRANSFER_TOKENS ;
- NIL operation ; SWAP ; CONS } } ;
- PAIR }
- { # after T + 48, transfer everything to the buyer
- BALANCE ;
- DIP { DUP ; CDDDDAAR } ; # B
- DIIP { CDR } ;
- UNIT ; TRANSFER_TOKENS ;
- NIL operation ; SWAP ; CONS ;
- PAIR} } } } } } }
-
-XII - Full grammar
-------------------
-
-::
-
- ::=
- |
- |
- |
- |
- |
- |
- |
- |
- |
- | Unit
- | True
- | False
- | Pair
- | Left
- | Right
- | Some
- | None
- | { ; ... }
- | { Elt ; ... }
- | instruction
- ::=
- | { ... }
- | DROP
- | DUP
- | SWAP
- | PUSH
- | SOME
- | NONE
- | UNIT
- | IF_NONE { ... } { ... }
- | PAIR
- | CAR
- | CDR
- | LEFT
- | RIGHT
- | IF_LEFT { ... } { ... }
- | IF_RIGHT { ... } { ... }
- | NIL
- | CONS
- | IF_CONS { ... } { ... }
- | SIZE
- | EMPTY_SET
- | EMPTY_MAP
- | MAP { ... }
- | ITER { ... }
- | MEM
- | GET
- | UPDATE
- | IF { ... } { ... }
- | LOOP { ... }
- | LOOP_LEFT { ... }
- | LAMBDA { ... }
- | EXEC
- | DIP { ... }
- | FAILWITH
- | CAST
- | RENAME
- | CONCAT
- | SLICE
- | PACK
- | UNPACK
- | ADD
- | SUB
- | MUL
- | EDIV
- | ABS
- | NEG
- | LSL
- | LSR
- | OR
- | AND
- | XOR
- | NOT
- | COMPARE
- | EQ
- | NEQ
- | LT
- | GT
- | LE
- | GE
- | SELF
- | CONTRACT
- | TRANSFER_TOKENS
- | SET_DELEGATE
- | CREATE_ACCOUNT
- | CREATE_CONTRACT
- | CREATE_CONTRACT { ... }
- | IMPLICIT_ACCOUNT
- | NOW
- | AMOUNT
- | BALANCE
- | CHECK_SIGNATURE
- | BLAKE2B
- | SHA256
- | SHA512
- | HASH_KEY
- | STEPS_TO_QUOTA
- | SOURCE
- | SENDER
- | ADDRESS
- ::=
- |
- | key
- | unit
- | signature
- | option
- | list
- | set
- | operation
- | address
- | contract
- | pair
- | or
- | lambda
- | map
- | big_map
- ::=
- | int
- | nat
- | string
- | bytes
- | mutez
- | bool
- | key_hash
- | timestamp
-
-XIII - Reference implementation
--------------------------------
-
-The language is implemented in OCaml as follows:
-
-- The lower internal representation is written as a GADT whose type
- parameters encode exactly the typing rules given in this
- specification. In other words, if a program written in this
- representation is accepted by OCaml's typechecker, it is guaranteed
- type-safe. This of course also valid for programs not handwritten but
- generated by OCaml code, so we are sure that any manipulated code is
- type-safe.
-
- In the end, what remains to be checked is the encoding of the typing
- rules as OCaml types, which boils down to half a line of code for
- each instruction. Everything else is left to the venerable and well
- trusted OCaml.
-
-- The interpreter is basically the direct transcription of the
- rewriting rules presented above. It takes an instruction, a stack and
- transforms it. OCaml's typechecker ensures that the transformation
- respects the pre and post stack types declared by the GADT case for
- each instruction.
-
- The only things that remain to be reviewed are value dependent
- choices, such as that we did not swap true and false when
- interpreting the If instruction.
-
-- The input, untyped internal representation is an OCaml ADT with the
- only 5 grammar constructions: ``String``, ``Int``, ``Seq`` and
- ``Prim``. It is the target language for the parser, since not all
- parsable programs are well typed, and thus could simply not be
- constructed using the GADT.
-
-- The typechecker is a simple function that recognizes the abstract
- grammar described in section X by pattern matching, producing the
- well-typed, corresponding GADT expressions. It is mostly a checker,
- not a full inferrer, and thus takes some annotations (basically the
- input and output of the program, of lambdas and of uninitialized maps
- and sets). It works by performing a symbolic evaluation of the
- program, transforming a symbolic stack. It only needs one pass over
- the whole program.
-
- Here again, OCaml does most of the checking, the structure of the
- function is very simple, what we have to check is that we transform a
- ``Prim ("If", ...)`` into an ``If``, a ``Prim ("Dup", ...)`` into a
- ``Dup``, etc.
diff --git a/vendors/tezos-modded/docs/whitedoc/octopus.svg b/vendors/tezos-modded/docs/whitedoc/octopus.svg
deleted file mode 100644
index 39085da7e..000000000
--- a/vendors/tezos-modded/docs/whitedoc/octopus.svg
+++ /dev/null
@@ -1,1558 +0,0 @@
-
-
-
-
\ No newline at end of file
diff --git a/vendors/tezos-modded/docs/whitedoc/p2p.rst b/vendors/tezos-modded/docs/whitedoc/p2p.rst
deleted file mode 100644
index 36b347952..000000000
--- a/vendors/tezos-modded/docs/whitedoc/p2p.rst
+++ /dev/null
@@ -1,127 +0,0 @@
-.. _p2p:
-
-The peer-to-peer layer
-======================
-
-This document explains the inner workings of the peer-to-peer layer of
-the Tezos shell. This part is in charge of establishing and
-maintaining network connections with other nodes (gossip).
-
-The P2P layer is instantiated by the node. It is parametrized by the
-type of messages that are exchanged over the network (to allow
-different P2P protocol versions/extensions), and the type of metadata
-associated to each peer. The latter is useful to compute a score for
-each peer that reflects the level of trust we have in it. Different
-policies can be used when communicating with peers with different
-score values.
-
-The P2P layer is comprised of a pool of connections, a set of
-operations on those connections, and a set of workers following the
-worker pattern pervasively used in the code base.
-
-The P2P layer is packaged in :package:`tezos-p2p`, which has
-documentation for all modules.
-
-General operation
------------------
-
-I/O Scheduling
-~~~~~~~~~~~~~~
-
-The P2P layer uses a scheduling mechanism in order to control its
-bandwidth usage as well as implementing different policies
-(e.g. read/write quotas) to different peers. For now, each peer is
-granted a fair share of the global allocated bandwidth, but it is
-planned for the individual allocated bandwidth to each peer to be a
-function of the peer's score.
-
-Encryption
-~~~~~~~~~~
-
-The connection between each peer is encrypted using `NaCl`
-authenticated-encryption `API `__. This
-is done to provide an additional level of security and tamper-proof
-guarantees in the communication between peers.
-
-Message queues
-~~~~~~~~~~~~~~
-
-On top of basic I/O scheduling, two finite-size typed message queues
-are used to store incoming (resp. outgoing) messages for each
-peer. This further restricts the speed at which communication is
-possible with a peer; when a queue is full, it is not possible to read
-(resp. write) an additional message. The high-level
-`P2p_socket.connection
-<../api/odoc/tezos-p2p/Tezos_p2p/P2p_socket/index.html#type-connection>`__
-type by the P2P layer is basically a UNIX socket upgraded with I/O
-scheduling, peer metadata, cryptographic keys and two messages queues
-operated by dedicated workers which operate on those queues.
-
-Pool of connections
-~~~~~~~~~~~~~~~~~~~
-
-All the above modules are used in `P2p_pool
-<../api/odoc/tezos-p2p/Tezos_p2p/P2p_pool/index.html>`__, which
-constitutes the core of the P2P layer, together with the worker
-processes described below. It comprises various tables of connections
-as well as methods to query them, also connections are extended with
-another message queue where lower level messages (like responses to
-ping) are filtered out and only application-level messages are kept.
-
-The main entry point of the P2P layer is in module `P2p
-<../api/odoc/tezos-p2p/Tezos_p2p/P2p/index.html>`__. See below
-for a description of workers acting onto the P2P layer.
-
-Welcome worker
---------------
-
-The welcome worker is responsible for accepting incoming connections
-and register them into the pool of connections managed by the P2P
-layer. It basically runs the ``accept(2)`` syscall and call
-`P2p_pool.accept
-<../api/odoc/tezos-p2p/Tezos_p2p/P2p_pool/index.html#val-accept>`__ so
-that it is made aware of an incoming connection. From there, the pool
-will decide how this new connection must be handled.
-
-{Black, While, Grey}lists
-~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The welcome worker takes care of filtering all incoming connections using two
-static lists of addresses handled either by ``tezos-admin-client`` and a system
-table that is handled automatically by the p2p layer. The node admin can block
-or whitelist individual ip addresses, while the p2p layer is in charge of
-temporarily banning ip addresses and peers who misbehave. The delay to remove
-an ip address from the greylist table is defined by the configuration variable
-``greylist_timeout``, while peers that are greylisted are periodically removed.
-The node admin can also flush greylist tables with the ``tezos-admin-client``.
-
-Maintenance worker
-------------------
-
-The maintenance worker is in charge of establishing an appropriate
-number of connections with other nodes in order to guarantee a
-realistic view of the state of the blockchain. It is created with a
-set of targets to reach regarding the desired amount of peers it needs
-to keep an active connection to.
-
-At the pool level, the minimum (resp. maximum) acceptable number of
-connections is defined.
-
-At the maintenance worker level, two other sets of thresholds are
-defined: ``target`` (min and max) and ``threshold`` (min and max).
-
-Given these bounds, the maintenance worker:
-
-* Will be triggered every two minutes, when asked by the shell, or
- when the minimum or maximum number of acceptable connections is
- reached, whichever happens first.
-
-* Will perform the following actions when triggered: if the number of
- connections is above ``max_threshold``, it will kill connections
- randomly until it reaches ``max_target`` connections. If the number of
- connections is below ``min_threshold``, it will attempt to connect to
- peers until it reaches at least ``min_target`` connections (and never
- more than ``max_target`` connections).
-
-The maintenance worker is also in charge of periodically run the
-greylists GC functions to unban ip addresses from the greylist.
diff --git a/vendors/tezos-modded/docs/whitedoc/packages.svg b/vendors/tezos-modded/docs/whitedoc/packages.svg
deleted file mode 100644
index bed597efd..000000000
--- a/vendors/tezos-modded/docs/whitedoc/packages.svg
+++ /dev/null
@@ -1,3030 +0,0 @@
-
-
-
-
\ No newline at end of file
diff --git a/vendors/tezos-modded/docs/whitedoc/proof_of_stake.rst b/vendors/tezos-modded/docs/whitedoc/proof_of_stake.rst
deleted file mode 100644
index d6c9e0427..000000000
--- a/vendors/tezos-modded/docs/whitedoc/proof_of_stake.rst
+++ /dev/null
@@ -1,324 +0,0 @@
-.. _proof-of-stake:
-
-Proof-of-stake in Tezos
-=======================
-
-This document provides an in-depth description of the Tezos
-proof-of-stake algorithm as implemented in
-PsYLVpVvgbLhAhoqAkMFUo6gudkJ9weNXhUYCiLDzcUpFpkk8Wt
-
-Blocks
-------
-
-The Tezos blockchain is a linked list of blocks. Blocks contain a
-header, and a list of operations. The header itself decomposes into a
-shell header (common to all protocols) and a protocol specific header.
-
-Shell header
-~~~~~~~~~~~~
-
-The shell header contains
-
-- ``level``: the height of the block, from the genesis block
-- ``proto``: number of protocol changes since genesis (mod 256)
-- ``predecessor``: the hash of the preceding block.
-- ``timestamp``: the timestamp at which the block is claimed to have
- been created.
-- ``validation_pass``: number of validation passes (also number of
- lists of lists of operations)
-- ``fitness``: a sequence of sequences of unsigned bytes, ordered by
- length and then lexicographically. It represents the claimed fitness
- of the chain ending in this block.
-- ``operations_hash`` The hash of a list of root hashes of merkle
- trees of operations. There is one list of operations per
- validation pass
-- ``context`` Hash of the state of the context after application of
- this block.
-
-Protocol header (for tezos.alpha):
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-- ``signature``: a digital signature of the shell and protocol headers
- (excluding the signature itself).
-- ``priority``: the position in the priority list of delegates at which
- the block was baked.
-- ``seed_nonce_hash``: a commitment to a random number, used to
- generate entropy on the chain. Present in only one out of
- (``BLOCKS_PER_COMMITMENT`` = 32) blocks.
-- ``proof_of_work_nonce``: a nonce used to pass a low-difficulty
- proof-of-work for the block, as a spam prevention measure.
-
-Block size
-~~~~~~~~~~
-
-Tezos does not download blocks all at once, but rather considers headers
-and various lists of operations separately. In Tezos.alpha, a maximum
-size in bytes is applied to the list of transactions
-``MAX_TRANSACTION_LIST_SIZE`` = 500kB (that's 5MB every 10 minutes at
-most).
-
-Other lists of operations (endorsements, denunciations, reveals) are
-limited in terms of number of operations (though the defensive
-programming style also puts limits on the size of operations it
-expects).
-
-This ensure that consensus critical operations do not compete with
-transactions for block space.
-
-Delegation
-----------
-
-Tezos.alpha uses a delegated proof-of-stake model. The acronym DPOS has come to
-designate a specific type of algorithm used, for instance in Bitshares.
-This is *not* the model used in Tezos.alpha, though there is a concept
-of delegation.
-
-Delegates
-~~~~~~~~~
-
-In tezos.alpha, tokens are controlled through a private key called the
-*manager key*. Tezos.alpha accounts let the manager specify a public
-delegate key. This key may be controlled by the manager themselves, or
-by another party. The responsibility of the delegate is to take part in
-the proof-of-stake consensus algorithm and in the governance of Tezos.
-
-The manager can generally change the delegate at any time, though
-contract can be marked to specify an immutable delegate. Though
-delegation can be changed dynamically, the change only becomes effective
-after a few cycles.
-
-There are also default accounts in Tezos, which are just the hash of the
-public key. These accounts do not have an attached delegate key and do
-not participate in the proof-of-stake algorithm.
-
-Finally, delegate accounts (used for placing safety deposits) are
-automatically delegated to the delegate itself.
-
-Active and passive delegates
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-A delegate can be marked as either active or passive. A passive delegate
-cannot be selected for baking or endorsement.
-
-A delegate becomes passive for cycle ``n`` when they fail to create any
-of the blocks or endorsements in the past ``CYCLES_BEFORE_DEACTIVATION``
-= 5 cycles, or to change their security deposit. So, in this case, in
-cycles ``n-1``, ``n-3``, ..., ``n - CYCLES_BEFORE_DEACTIVATION``.
-
-A small delegate who is afraid they might be deactivated because they
-were not given the opportunity to create any block or endorsement can
-ensure they do not become deactivated by making small, meaningless
-transactions with their security deposits once every two cycles.
-
-Discussion: giving ``CYCLES_BEFORE_DEACTIVATION`` a small value means
-the chain adapts more quickly to participants disappearing. It's not
-unlike the "difficulty adjustment" of Bitcoin. However, a long value
-would ensure that a minority fork progresses more slowly for a longer
-period of time than the majority fork. ``CYCLES_BEFORE_DEACTIVATION``
-gives the majority chain a "headstart".
-
-This does not affect voting rights for protocol changes.
-
-Rolls
-~~~~~
-
-In theory, it would be possible to give each token a serial number, and
-track the specific tokens assigned to specific delegates. However, it
-would be too demanding of nodes to track assignment at such a granular
-level. Instead we introduce the concept of rolls. A roll represents a
-set of coins delegated to a given key. When tokens are moved, or a
-delegate for a contract is changed, the rolls change delegate according
-to the following algorithm.
-
-Each delegate has a stack of roll ids plus some "change" which is always
-an amount smaller than ``TOKENS_PER_ROLLS``. When tokens are moved from
-one delegate to the other, first, the change is used. If it is not
-enough, rolls need to be "broken" which means that they move from the
-delegate stack to a global, unallocated, roll stack. This is done until
-the amount is covered, and some change possibly remains.
-
-Then, the other delegate is credited. First the amount is added to the
-"change". If it becomes greater than ``TOKENS_PER_ROLLS``, then rolls
-are unstacked from the global unallocated roll stack onto the delegate
-stack. If the global stack is empty, a fresh roll is created.
-
-This preserves the property that if the delegate is changed through
-several transactions, the roll assignment is preserved, even if each
-operation moves less than a full roll.
-
-The advantage of tracking tokens in this way is that a delegate creating
-a malicious fork cannot easily change the specific rolls assigned to
-them, even if they control the underlying tokens and shuffle them
-around.
-
-Rolls hold ``TOKENS_PER_ROLLS`` = 10,000 tokens and thus there should be
-about 80,000 rolls in the Tezos foundation's planned genesis block,
-though the number of rolls will increase with inflation and / or
-participation in the delegation.
-
-Roll snapshots
-~~~~~~~~~~~~~~
-
-Roll snapshots represent the state of rolls for a given block. Roll
-snapshots are taken every ``BLOCKS_PER_ROLL_SNAPSHOT`` = 256 blocks,
-that is 16 times per cycle. There is a tradeoff between memory
-consumption and economic efficiency. If roll snapshots are too frequent,
-they will consume a lot of memory. If they are too rare, strategic
-participants could purchase many tokens in anticipation of a snapshot
-and resell them right after.
-
-Cycles
-------
-
-Blocks in the Tezos.Alpha Blockchain are grouped into *cycles* of
-``BLOCKS_PER_CYCLE`` = 4,096 blocks. Since blocks are at least
-``TIME_BETWEEN_BLOCKS`` = one minute apart, this means a cycle lasts *at
-least* 2 days, 20 hours, and 16 minutes. In the following description,
-the current cycle is referred to as ``n``, it is the nth cycle from the
-beginning of the chain. Cycle ``(n-1)`` is the cycle that took place
-before the current one, cycle ``(n-2)`` the one before, cycle ``(n+1)``
-the one after, etc.
-
-At any point, the tezos shell will not implicitly accept a branch whose
-fork point is in a cycle more than ``PRESERVED_CYCLES`` = 5 cycles in the
-past (that is *at least* 14 days, 5 hours, and 20 minutes).
-
-Security deposits
-~~~~~~~~~~~~~~~~~
-
-The cost of a security deposit is ``BLOCK_SECURITY_DEPOSIT`` = 512 XTZ
-per block created and ``ENDORSEMENT_SECURITY_DEPOSIT`` = 64 XTZ per
-endorsement.
-
-Each delegate key has an associated security deposit account.
-When a delegate bakes or endorses a block the security deposit is
-automatically moved to the deposit account where it is frozen for
-``PRESERVED_CYCLES`` cycles, after which it is automatically moved
-back to the baker's main account.
-
-Since deposits are locked for a period of ``PRESERVED_CYCLES`` one can
-compute that at any given time, about ((``BLOCK_SECURITY_DEPOSIT`` +
-``ENDORSEMENT_SECURITY_DEPOSIT`` \* ``ENDORSERS_PER_BLOCK``) \*
-(``PRESERVED_CYCLES`` + 1) \* ``BLOCKS_PER_CYCLE``) / ``763e6`` = 8.25% of
-all tokens should be held as security deposits. It also means that a
-delegate should own over 8.25% of the amount of token delegated to them
-in order to not miss out on creating any block.
-
-Baking rights
-~~~~~~~~~~~~~
-
-Baking in tezos.alpha is the action of signing and publishing a block.
-In Bitcoin, the right to publish a block is associated with solving a
-proof-of-work puzzle. In tezos.alpha, the right to publish a block in
-cycle ``n`` is assigned to a randomly selected roll in a randomly
-selected roll snapshot from cycle ``n-PRESERVED_CYCLES-2``.
-
-We admit, for the time being, that the protocol generates a random seed
-for each cycle. From this random seed, we can seed a CSPRNG which is
-used to draw baking rights for a cycle.
-
-To each position, in the cycle, is associated a priority list of
-delegates.
-This is drawn randomly, with replacement, from the set of active rolls
-so it is possible that the same public key appears multiple times in
-this list.
-The first baker in the list is the first one who can bake a block at
-that level.
-If a delegate is for some reason unable to bake, the next delegate in
-the list can step up and bake the block.
-
-The delegate with the highest priority can bake a block with a timestamp
-greater than ``timestamp_of_previous_block`` plus
-``TIME_BETWEEN_BLOCKS`` = one minute. The one with the kth highest
-priority, ``k * TIME_BETWEEN_BLOCKS`` = k minutes.
-
-Baking a block gives a block reward of ``BLOCK_REWARD`` = 16 XTZ plus
-all fees paid by transactions inside the block.
-
-Endorsements
-~~~~~~~~~~~~
-
-To each baking slot, we associate a list of ``ENDORSERS_PER_BLOCK`` = 32
-*endorsers*. Endorsers are drawn from the set of delegates, by randomly
-selecting 32 rolls with replacement.
-
-Each endorser verifies the last block that was baked, say at level
-``n``, and emits an endorsement operation. The endorsement operations
-are then baked in block ``n+1`` and will contribute to the `fitness`
-of block ``n``. Once block ``n+1`` is baked, no other endorsement for
-block ``n`` will be considered valid.
-
-Endorsers receive a reward (at the same time as block creators do). The
-reward is ``ENDORSEMENT_REWARD`` = 2 / ``BLOCK_PRIORITY`` where block
-priority starts at 1. So the endorsement reward is only half if the
-block of priority 2 for a given slot is being endorsed.
-
-It is possible that the same endorser be selected ``k`` times for the
-same block, in this case ``k`` deposits are required and ``k`` rewards
-gained. However a single operation needs to be sent on the network to
-endorse ``k`` times the same block.
-
-Fitness
-~~~~~~~
-
-To each block we associate a measure of `fitness` which determines the
-quality of the chain leading to that block.
-This measure in Bitcoin is simply the length of the chain, in Tezos we
-add also the number of endorsements to each block.
-Given a block at level ``n`` with fitness ``f``, when we receive a new
-head that contains ``e`` endorsements for block ``n``, the fitness of
-the new head is ``f+1+e``.
-
-Inflation
-~~~~~~~~~
-
-Inflation from block rewards and endorsement reward is at most
-``ENDORSERS_PER_BLOCK`` \* ``ENDORSEMENT_REWARD`` + ``BLOCK_REWARD`` =
-80 XTZ. This means at most 5.51% annual inflation.
-
-Random seed
-~~~~~~~~~~~
-
-Cycle ``n`` is associated with a random seed, a 256 bit number generated
-at the end of cycle ``(n-PRESERVED_CYCLES-1)`` using commitments made during
-cycle ``(n-PRESERVED_CYCLES-2)``, in one out of every
-``BLOCKS_PER_COMMITMENT`` = 32 blocks.
-
-The commitment must be revealed by the original baker during cycle
-``(n-PRESERVED_CYCLES-1)`` under penalty of forfeiting the rewards and
-fees of the block that included the seed commitment (the associated
-security deposit is not forfeited).
-
-A *revelation* is an operation, and multiple revelations can thus be
-included in a block. A baker receives a ``seed_nonce_revelation_tip`` =
-1/8 XTZ reward for including a revelation.
-Revelations are free operations which do not compete with transactions
-for block space. Up to ``MAX_REVELATIONS_PER_BLOCK`` = 32 revelations
-can be contained in any given block. Thus, 1 /
-(``MAX_REVELATIONS_PER_BLOCK`` \* ``BLOCKS_PER_COMMITMENT``) = 1/1024 of
-the blocks in the cycle are sufficient to include all revelations.
-
-The revelations are hashed together to generate a random seed at the
-very end of cycle ``(n-PRESERVED_CYCLES-1)``.
-The seed of cycle ``(n-PRESERVED_CYCLES-2)`` is hashed with a constant
-and then with each revelation of cycle ``(n-PRESERVED_CYCLES-1)``.
-Once computed, this new seed is stored and used during cycle ``n``.
-
-Accusations
------------
-
-If two endorsements are made for the same slot or two blocks at the same
-height by a delegate, the evidence can be collected by an accurser and included
-in a block for a period of PRESERVED_CYCLES, including the current cycle.
-
-This accusation forfeits the entirety of the safety deposit and future reward up
-to that point in the cycle. Half is burned, half goes to the accuser in the form
-of a block reward.
-
-In the current protocol, accusations for the *same* incident can be made several
-times after the fact. This means that the deposits and rewards for the entire
-cycle are forfeited, including any deposit made, or reward earned, after
-the incident.
-
-Pragmatically, any baker who either double bakes or endorses in a given cycle
-should immediately stop both baking and endorsing for the rest of that cycle.
diff --git a/vendors/tezos-modded/docs/whitedoc/the_big_picture.rst b/vendors/tezos-modded/docs/whitedoc/the_big_picture.rst
deleted file mode 100644
index 2d6168b7c..000000000
--- a/vendors/tezos-modded/docs/whitedoc/the_big_picture.rst
+++ /dev/null
@@ -1,327 +0,0 @@
-.. _software_architecture:
-
-Tezos Software Architecture
-===========================
-
-This document contains two section. The first section, which should be
-readable by anyone, describes the main elements of Tezos from a
-distance. It abstracts from all plumbing and both internal and system
-dependencies to give a simple view of the main components, their
-responsibilities and interactions. The second part is written for
-developers, and is at the level of OPAM packages.
-
-The Big Picture
----------------
-.. _the_big_picture:
-
-The diagram below shows a very coarse grained architecture of Tezos.
-
-|Tezos architecture diagram|
-
-The characteristic that makes Tezos unique is its self-amending
-property. The part that amends itself is called the *economic protocol*
-(the green eye of the octopus), sometimes abbreviated by protocol or
-even proto in the source code. The rest of a Tezos node is what we call
-the *shell* (the blue octopus).
-
-The protocol is responsible for interpreting the transactions and other
-administrative operations. It also has the responsibility to detect
-erroneous blocks.
-
-An important thing to notice is that the protocol always sees only one
-block chain. In other words, a linear sequence of blocks since the
-genesis. It does not know that it lives in an open network where nodes
-can propose alternative heads.
-
-Only the shell knows about the multiple heads. It is responsible for
-choosing between the various chain proposals that come from the bakers
-(the programs that cook new blocks) of the network. The shell has the
-responsibility of selecting and downloading alternative chains, feed
-them to the protocol, which in turn has the responsibility to check them
-for errors, and give them an absolute score. The shell then simply
-selects the valid head of highest absolute score. This part of the shell
-is called :ref:`the validator`.
-
-The rest of the shell includes the peer-to-peer layer, the disk storage
-of blocks, the operations to allow the node to transmit the chain data
-to new nodes and the versioned state of the ledger. In-between the
-validator, the peer-to-peer layer and the storage sits a component
-called the distributed database, that abstracts the fetching and
-replication of new chain data to the validator.
-
-Protocols are compiled using a tweaked OCaml compiler (green part on the
-left of the picture) that does two things. First, it checks that the
-protocol’s main module has the right type. A good analogy is to see
-protocol as plug-ins, and in this case, it means that it respects the
-common plugin interface. Then, it restricts the typing environment of
-the protocol’s code so that it only calls authorized modules and
-functions. Seeing protocols as plug-ins, it means that the code only
-called primitives from the plug-in API. It is a form of statically
-enforced sandboxing.
-
-Finally, the RPC layer (in yellow on the right in the picture) is an
-important part of the node. It is how the client, third party
-applications and daemons can interact with the node and introspect its
-state. This component uses the mainstream JSON format and HTTP protocol.
-It uses in-house libraries ``ocplib-resto`` and ``ocplib-json-typed``
-(via the module :ref:`Data_encoding `). It
-is fully inter-operable, and auto descriptive, using JSON schema.
-
-.. |Tezos architecture diagram| image:: octopus.svg
-
-
-Software Architecture and Package Relashionships
-------------------------------------------------
-.. _packages:
-
-The diagram below shows the main OPAM packages present in the source
-code of Tezos, and their dependencies. The ``tezos-`` prefix has been
-dropped for clarity.
-
-|Tezos source packages diagram|
-
-In green at the bottom are binaries. Highlighted in yellow are the OPAM
-packages (sometimes with shortened names). Black arrows show direct
-dependencies. Orange arrows show other indirect relationships (code
-generation, interface sharing), explained below. The part circled in
-blue, contains modules that bear no dependency to Unix, and can thus
-be compiled to JavaScript. External dependencies are not shown in this
-illustration.
-
-Base and below
-~~~~~~~~~~~~~~
-
-At the center, the :package:`tezos-base` package is where
-the blockchain specific code starts. Before it are the set of libraries
-that are used everywhere for basic operations.
-
- - :package:`tezos-stdlib` contains a few extensions over the
- OCaml standard library (a few string primitives, an ``Option``
- module, etc.), a few ``Lwt`` utilities, and a ``Compare`` module
- that implements monomorphic comparison operators.
- - :package:`tezos-data-encoding` is the in-house
- combinator-based serialization library. From a single type
- description ``t encoding``, the code can read to and write from
- values of type ``t`` both binary and JSON representations. For
- both, the library provides machine and human-readable documentations
- by the use of documentation combinators. The JSON part depends on
- :opam:`ocplib-json-typed`.
- A :ref:`tutorial` is available for this library.
- - :package:`tezos-error-monad` is an in-house monadic
- interface to the OCaml ``('a, 'b) result`` type, that fixes the
- ``'b`` to an extensible type ``error`` (actually a list, to hold an
- error trace). When extending the type, programmers must also call
- the ``register_error`` function that registers a pretty printer and
- an encoding for serialization.
- A :ref:`tutorial` is available for this library.
- - :package:`tezos-rpc` provides the basics of Tezos' RPC service
- mechanism. It provides combinators for building service hierarchies
- à la Ocsigen/Eliom, registering and calling services. This module
- is based on :opam:`ocplib-resto`, that allows for automatic
- generation of a machine and human-readable of the hierarchy of
- services: the structure of URLs and the expected formats for input
- and output bodies, via the use of ``data_encoding``.
- - :package:`tezos-crypto` wraps the external cryptography
- libraries that we use. We try to use minimal reference
- implementations, with as thin as possible bindings, and
- rely on libraries from the
- `HACL* project `_,
- written and verified in the F* programming language, and extracted
- to C.
- - :package:`tezos-micheline` is the concrete syntax used by
- Michelson, the language of smart contracts. It mostly contains the
- generic, untyped AST, a printer and a parser.
- - :package:`tezos-base` wraps all these module in a common foundation
- for all the other components of Tezos, and introduces the data
- structures of the blockchain (e.g. ``Block_hash``,
- ``Block_header``, ``Block_locator``, ``Fitness``, ``P2p_identity``)
- that are shared between the shell, economic protocol, client,
- daemons and third party software. It also rewraps some modules from
- ``crypto`` as functors that build all-in-one modules for a given
- type (for instance, the module for block hashes contains all
- possible converters, command line and RPC argument builders, pretty
- printers, an autocompleter, etc.). This package also contains the
- ``cli_entries`` module that we use to handle command line parsing
- in some executables.
-
-The Shell
-~~~~~~~~~
-
-The shell is the part of the node responsible for all communications,
-peer-to-peer and RPC, acting as a cocoon around the economic
-protocols.
-
- - :package:`tezos-shell-services` contains the definition of the
- node's service hierarchy, and calling functions to use in the
- client (or any third party software). As this library is linked
- into the client to call the services in a type-safe way, only the
- description of services is done here. The registration of handlers
- is done in the rest of the node's implementation.
- - :package:`tezos-rpc-http` uses :opam:`cohttp` to implement the RPC
- over HTTP server and client, allowing to make actual use of
- services declared using :package:`tezos-rpc`.
- - :package:`tezos-p2p` is the in-house peer-to-peer layer.
- - :package:`tezos-storage` contains the raw simple key-value store
- used for the chain data, and the raw versioned key-value store
- used for storing the ledger's context (one version per
- block). This is implemented using :opam:`irmin` and currently
- :package:`lmdb`.
- - :package:`tezos-protocol-updater` maintains the table of available
- protocol versions, embedded or dynamically linked.
- - :package:`tezos-shell` implements the scheduling of block
- validations, the mempool management, and the distributed database.
- A description is available in :ref:`this document`.
-
-The Economic Protocol Environment and Compiler
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Economic protocols are compiled by a specific version of the OCaml
-compiler. This compiler restricts the set of modules available to the
-economic protocol, as a form of static sandboxing. It also generates a
-functorized version of the protocol, to make the execution of the
-protocol in alternative environment possible.
-
- - :package:`tezos-protocol-environment-sigs` contains the modules
- that are available to the economic protocol. A review of this
- sandbox is available :ref:`here`. This
- modules include a stripped down standard library, and interfaces
- to the crypto APIs, RPC definitions, and key-value store.
-
- - :package:`tezos-protocol-compiler` is the compiler for economic
- protocols: an alternative driver to the OCaml
- :opam:`ocaml-compiler-libs` that typechecks within the protocol
- environment, and performs some more checks on the protocol code.
-
- - ``tezos-protocol-xxx`` is produced by the protocol compiler
- and contains a functorized version of protocol ``xxx`` that takes its
- standard library as parameter. This parameter can be filled with
- any of the implementations described in the two points below.
-
- - :package:`tezos-protocol-environment-shell` is the instance of the
- environment whose RPC service registration and storage access are
- the ones of the node. This is the environment that is fed by the
- node when loading new protocols.
-
- - :package:`tezos-protocol-environment` contains three alternative
- instances of the protocol environment: one whose context access
- function are dummy ones which can be used when only the types and
- non contextual functions of the protocol are needed, another that
- simulates the key-value store in memory for testing, and a functor
- that let you build an environment from a few context accessors.
-
- - ``tezos-embedded-protocol-xxx`` contains a version of protocol
- ``xxx`` whose standard library is pre-instantiated to the shell's
- implementation, these are the ones that are linked into the
- node. It also contains a module that registers the protocol in the
- node's protocol table.
-
-The Embedded Economic Protocols
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Three economic protocols are included in the main Tezos repository.
-
- - :package:`tezos-protocol-genesis`
- (:package:`tezos-embedded-protocol-genesis`) is the protocol of
- the genesis block. It accepts a single block, signed by a activator
- whose public key is hardcoded, that single action is to switch to
- a new protocol chosen by the activator.
- - :package:`tezos-protocol-alpha`
- (:package:`tezos-embedded-protocol-alpha`) is the first real
- protocol of Tezos. A :ref:`tutorial` is available
- to start reading the protocol's code.
- - :package:`tezos-protocol-demo`
- (:package:`tezos-embedded-protocol-demo`) is just a demo protocol
- that does nothing interesting but has the right shape.
-
-The Client Library
-~~~~~~~~~~~~~~~~~~
-
-The client is split into many packages, to enforce three separation
-lines: shell vs economic protocol, Unix dependent vs Javascript
-compatible, and library vs command line interface.
-
- - :package:`tezos-client-base` define the client context, which is
- an object whose methods allow for: accessing a wallet of keys,
- interacting via the user, making RPC calls, and signing data using
- signer plug-ins. Most of the, including RPC calling functions from
- :package:`tezos-shell-services` and
- :package:`tezos-protocol-alpha`, are abstracted over this object
- type. That way, it is possible to use the same code for different
- platforms or toolkits.
- - :package:`tezos-client-alpha` provides some functions to perform
- the operations of protocol alpha using the wallet and signers from
- the client context.
- - :package:`tezos-client-commands` plugs the basic context access
- functions from :package:`tezos-client-base` as handlers for the
- commands of the ``tezos-client`` command line wallet.
- - :package:`tezos-client-alpha-commands` plugs the functions from
- :package:`tezos-client-alpha` as handlers for the alpha specific
- commands of the ``tezos-client`` command line wallet.
- - :package:`tezos-client-genesis` contains the basic activator
- commands available on the genesis protocol.
- - :package:`tezos-client-base-unix` implements configuration file
- and wallet storage in Unix files, user interaction via the Unix
- console, and terminal based signer plug-ins.
-
-Tests Packages
-~~~~~~~~~~~~~~
-
-The tests are split into various packages, testing more and more
-elements while following the dependency chain. Use ``make test`` to
-run them.
-
- - :package-name:`tezos-client`
- (in directory :src:`src/bin_client/test/`):
- end-to-end tests as shell scripts that launch a local sandboxed node
- and performs various tasks using the client
- - :package-name:`tezos-p2p`
- (in directory :src:`src/lib_p2p/test/`):
- tests of the peer-to-peer layer, independently of the Tezos gossip
- protocol (establishing connections, propagating peers, etc.)
- - :package-name:`tezos-protocol-environment`
- (in directory :src:`src/lib_protocol_environment/test/`):
- tests for the in-memory context implementation.
- - :package-name:`tezos-shell`
- (in directory :src:`src/lib_shell/test/`):
- tests for the chain data storage.
- - :package-name:`tezos-stdlib`
- (in directory :src:`src/lib_stdlib/test/`):
- tests for the basic data structures.
- - :package-name:`tezos-storage`
- (in directory :src:`src/lib_storage/test/`):
- tests for the versioned key-value context.
- - :package-name:`tezos-protocol-alpha`
- (in directory :src:`src/proto_alpha/lib_protocol/test/`):
- tests of the alpha protocol (without launching a node).
- - :package-name:`tezos-crypto`
- (in directory :src:`src/lib_crypto/test/`):
- tests for the in-house merkle trees.
- - :package-name:`tezos-data-encoding`
- (in directory :src:`src/lib_data_encoding/test/`):
- tests for the JSON and binary serialization and deserialization.
-
-The Final Executables
-~~~~~~~~~~~~~~~~~~~~~
-
- - :package:`tezos-node` provides the node launcher binary
- ``tezos-node``. All the algorithmic being implemented in the
- shell, this package only implements the node's CLI. It also
- provides the sandboxed node shell script launcher (see the main
- readme).
- - :package:`tezos-client` provides the ``tezos-client`` and
- ``tezos-admin-client`` binaries. The former contains a small
- comand line wallet, the latter an administration tool for the
- node. It also provides a shell script that configures a shell
- environment to interact with a sandboxed node.
- - :package:`tezos-baker-alpha` provides the ``tezos-baker-alpha``
- binary.
- - :package:`tezos-endorser-alpha` provides the ``tezos-endorser-alpha``
- binary.
- - :package:`tezos-accuser-alpha` provides the ``tezos-accuser-alpha``
- binary.
- - :package:`tezos-protocol-compiler` provides the
- ``tezos-protocol-compiler`` binary that is used by the node to
- compile new protocols on the fly, and that can be used for
- developing new protocols.
-
-.. |Tezos source packages diagram| image:: packages.svg
diff --git a/vendors/tezos-modded/docs/whitedoc/validation.rst b/vendors/tezos-modded/docs/whitedoc/validation.rst
deleted file mode 100644
index ab8d1f80e..000000000
--- a/vendors/tezos-modded/docs/whitedoc/validation.rst
+++ /dev/null
@@ -1,120 +0,0 @@
-.. _validation:
-
-The validation subsystem
-========================
-
-This document explains the inner workings of the validation subsystem
-of the Tezos shell, that sits between the peer-to-peer layer and the
-economic protocol. This part is in charge of validating chains, blocks
-and operations that come from the network, and deciding whether they
-are worthy to propagate. It is composed of three main parts: the
-:ref:`validator`, the
-:ref:`prevalidator`, and
-the :ref:`distributed DB`.
-
-|Tezos validation diagram|
-
-Validator
----------
-.. _validator_component:
-
-The validator is the component responsible for checking that blocks
-coming from the network or a baker are valid, w.r.t. the rules defined
-by the economic protocol, and for selecting the block that it
-considers to be the current head of the blockchain.
-
-The validator is written as a collection of workers: local event loops
-communicating with each other via message passing. Workers are spawned
-and killed dynamically, according to connected peers, incoming blocks
-to validate, and active (test)chains.
-
-A *chain validator* worker is launched by the validator for each
-*chain* that it considers alive. Each chain validator is responsible for
-handling blocks that belong to this chain, and select the best head for
-this chain. A main chain validator is spawned for the main chain that
-starts at the genesis, a second one when there is an active test
-chain. Forking a chain is decided from within the economic protocol. In
-version Alpha, this is only used to try new protocols before self
-amending the main chain.
-
-The chain validator spawns one *peer validator* worker per connected
-peer. This set is updated, grown or shrunk on the fly, according to the
-connections and disconnections signals from the peer-to-peer component.
-Each peer validator will treat new head proposals from the associated
-peer, one at a time, in a loop. In the simple case, when a peer
-receives a new head proposal that is a direct successor of the current
-local head, it launches a simple *head increment* task: it retrieves
-all the operations and triggers a validation of the block. When the
-difference between the current head and the examined proposal is
-more than one block, mostly during the initial bootstrap phase, the
-peer worker launches a *bootstrap pipeline* task.
-
-A third scheme is planned (but not yet implemented) for validating
-alternative chains: the *multipass validator*. This method is quite more
-complex, its goal is to detect erroneous blocks as soon as possible,
-without having to download all the chain data. This will work by first
-validating the block headers, then the operations that act on the
-fitness, and finally the remaining operations. The mechanism is
-actually a bit more flexible, and allows for an arbitrary number of
-lists of operations. The shell will only consider forks of a given
-length, that is exported by the protocol, so that block headers and
-operations are validated in the context of an ancestor block that is
-in a close enough time window. In version Alpha, the check performed
-on block headers is that the baking slots, baker signatures and
-timestamp deltas are right. It can also detect too large fitness gaps,
-as the fitness difference between two consecutive blocks is bounded in
-Alpha. The operations that act on fitness are endorsements, whose
-checks consist in verifying the endorsement slots and endorsers'
-signatures. For that to be sound, the fork limit is set to not allow
-rewinding before the baking and endorsing slots are set.
-
-Each of these three peer validator tasks (head increment, bootstrap
-pipeline or multipass) will interact with the distributed DB to get
-the data they need (block headers and operations). When they have
-everything needed for a block, they will call the *block validator*.
-
-The *block validator* validates blocks (currently in sequence),
-assuming that all the necessary data have already been retrieved from
-the peer-to-peer network. When a block is valid, it will notify the
-corresponding chain validator, that may update its head. In this case,
-the chain validator will propagate this information to its associated
-*prevalidator*, and may decide to kill or spawn the test network
-according to the protocol's decision.
-
-Prevalidator
-------------
-.. _prevalidator_component:
-
-To each chain validator is associated a *prevalidator* (this may become
-an option in the future, to allow running nodes on machines with less
-RAM), that is responsible for the transmission of operations for this
-chain over the peer-to-peer network.
-
-To prevent spam, this prevalidator must select the set of operations
-that it considers valid, and the ones that it chooses to broadcast.
-This is done by constantly baking a dummy block, floating over the
-current head, and growing as new operations are received.
-
-Operations that get included can be broadcast unconditionally.
-
-Operations that are included are classified into categories. Some
-(such as bad signatures or garbage byte sequences) are dismissed. They
-are put in a temporary bounded set for quick rejection, and the peer
-that sent it is kicked. Some other operations are temporarily refused:
-they come too soon or too late. For instance, in Alpha, contracts have
-counters, and operations with counters in the future are classified as
-temporarily refused. A malicious peer could easily flood the mempool
-with such operations, so they are put in a bounded set. Another
-bounded set is also kept for a third kind of non inclusion: operations
-that could be valid in another branch.
-
-Distributed DB
---------------
-.. _DDB_component:
-
-The gathering of resources needed for validation is centralized in the
-*distributed db*. This component allocates a slot per requested
-resource, whose priority depends on the number of peer validators
-requesting it.
-
-.. |Tezos validation diagram| image:: validation.svg
diff --git a/vendors/tezos-modded/docs/whitedoc/validation.svg b/vendors/tezos-modded/docs/whitedoc/validation.svg
deleted file mode 100644
index 7878b165f..000000000
--- a/vendors/tezos-modded/docs/whitedoc/validation.svg
+++ /dev/null
@@ -1,1578 +0,0 @@
-
-
-
-
\ No newline at end of file
diff --git a/vendors/tezos-modded/docs/whitedoc/voting.rst b/vendors/tezos-modded/docs/whitedoc/voting.rst
deleted file mode 100644
index f6061a763..000000000
--- a/vendors/tezos-modded/docs/whitedoc/voting.rst
+++ /dev/null
@@ -1,181 +0,0 @@
-.. _voting:
-
-The Voting Process
-==================
-
-The design of the Tezos Node allows the consensus protocol to be
-amended, that is replaced by another set of OCaml files which
-implement the API of a valid protocol.
-
-In the current protocol the amendment procedure is guided by a voting
-procedure where delegates can propose, select and test a candidate
-protocol before activating it.
-Delegates take part in the amendment procedure with an influence
-proportional to their stake, one roll one vote.
-
-The procedure consists of four periods, each of 32768 blocks (or
-~three weeks), for a total of approximately three months.
-
-Other than this page, there is an excellent overview from `Jacob
-Arluck on medium.
-`_
-
-Periods
--------
-
-The voting procedure works as follows:
-
-- `Proposal period`: delegates can submit protocol amendment proposals using
- the `proposals` operation. At the end of a proposal period, the proposal with
- most supporters is selected and we move to a testing_vote period.
- If there are no proposals, or a tie between proposals, a new proposal
- period starts. Each delegate can submit a maximum of 20 proposals,
- including duplicates.
-- `Testing_vote period`: delegates can cast one vote to test or not the winning
- proposal using the `ballot` operation.
- At the end of a testing_vote period if participation reaches the quorum
- and the proposal has a super-majority in favor, we proceed to a testing
- period. Otherwise we go back to a proposal period.
-- `Testing period`: a test chain is forked for 48 hours to test a
- correct migration of the context.
- At the end of a testing period we move to a promotion_vote period.
-- `Promotion_vote period`: delegates can cast one vote to promote or not the
- tested proposal using the `ballot` operation.
- At the end of a promotion_vote period if participation reaches the quorum
- and the tested proposal has a super-majority in favor, it is activated as
- the new protocol. Otherwise we go back to a proposal period.
-
-It is important to note that the stake of each delegated is computed
-at the beginning of each period.
-
-Super-majority and Quorum
--------------------------
-
-Both voting periods work in the same way, only the subject of the
-vote differs.
-During a vote a delegate can cast a single Yea, Nay or Pass vote.
-A vote is successful if it has super-majority and the participation
-reaches the current quorum.
-
-`Super-majority` means the Yeas are more than 8/10 of Yeas+Nays votes.
-The `participation` is the ratio of all received votes, including
-passes, with respect to the number of possible votes. The `quorum`
-starts at 80% and at each vote it is updated using the old quorum and
-the current participation with the following coefficients::
-
- newQ = oldQ * 8/10 + participation * 2/10
-
-More details can be found in the file
-``src/proto_alpha/lib_protocol/src/amendment.ml``.
-
-Operations
-----------
-
-There are two operations used by the delegates: ``proposals`` and ``ballot``.
-A proposal operation can only be submitted during a proposal period.
-
-::
-
- Proposals : {
- source: Signature.Public_key_hash.t ;
- period: Voting_period_repr.t ;
- proposals: Protocol_hash.t list ; }
-
-Source is the public key hash of the delegate, period is the unique
-identifier of each voting period and proposals is a non-empty list of
-maximum 20 protocol hashes.
-The operation can be submitted more than once but only as long as the
-cumulative length of the proposals lists is less than 20.
-
-A ballot operation can only be submitted during one of the voting
-periods, and only once per period.
-
-::
-
- Ballot : {
- source: Signature.Public_key_hash.t ;
- period: Voting_period_repr.t ;
- proposal: Protocol_hash.t ;
- ballot: Vote_repr.ballot ; }
-
-Source and period are the same as above, while proposal is the
-currently selected proposal and ballot is one of ``Yea``, ``Nay`` or
-``Pass``.
-The pass vote allows a delegate to not influence a vote but still
-allowing it to reach quorum.
-
-More details can be found, as for all operations, in
-``src/proto_alpha/lib_protocol/src/operation_repr.ml``.
-The binary format is described by ``tezos-client describe unsigned
-operation``.
-
-Client Commands
----------------
-
-Tezos' client provides a command to show the status of a voting period.
-It displays different informations for different kind of periods, as
-in the following samples::
-
- $ tezos-client show voting period
- Current period: "proposal"
- Blocks remaining until end of period: 59
- Current proposals:
- PsNa6jTtsRfbGaNSoYXNTNM5A7c3Lji22Yf2ZhpFUjQFC17iZVp 400
-
- $ tezos-client show voting period
- Current period: "testing_vote"
- Blocks remaining until end of period: 63
- Current proposal: PsNa6jTtsRfbGaNSoYXNTNM5A7c3Lji22Yf2ZhpFUjQFC17iZVp
- Ballots: { "yay": 400, "nay": 0, "pass": 0 }
- Current participation 20.00%, necessary quorum 80.00%
- Current in favor 400, needed supermajority 320
-
- $ tezos-client show voting period
- Current period: "testing"
- Blocks remaining until end of period: 64
- Current proposal: PsNa6jTtsRfbGaNSoYXNTNM5A7c3Lji22Yf2ZhpFUjQFC17iZVp
-
-It should be noted that the number 400 above is a number of rolls.
-The proposal has a total of 400 rolls, which may come from several
-delegates. The same applies for the ballots, there are 400 rolls in
-favor of testing protocol PsNa6jTt.
-
-Submit proposals
-~~~~~~~~~~~~~~~~
-
-During a proposal period, the list of proposals can be submitted with::
-
- tezos-client submit proposals for ...
-
-Remember that each delegate can submit a maximum of 20 protocol
-hashes including duplicates.
-Moreover each proposal is accepted only if it meets one of the
-following two conditions:
-
-- the protocol hash was already proposed on the network. In this case
- we can submit an additional proposal that "upvotes" an existing one
- and our rolls are added to the ones already supporting the proposal.
-- the protocol is known by the node. In particular the first proposer
- of a protocol should be able to successfully inject the protocol in
- its node which performs some checks, compiles and loads the
- protocol.
-
-Submit ballots
-~~~~~~~~~~~~~~
-
-During a voting period, being it a testing vote or a promotion vote,
-ballots can be submitted once with::
-
- tezos-client submit ballot for
-
-Other resources
-~~~~~~~~~~~~~~~
-
-For more details on the client commands refer to the manual at
-:ref:`client_manual`.
-
-For vote related RPCs check the :ref:`rpc_index` under the prefix
-``vote/``.
-
-For Ledger support refer to Obsidian Systems' `documentation
-`_.
diff --git a/vendors/tezos-modded/dune b/vendors/tezos-modded/dune
deleted file mode 100644
index c8ef27903..000000000
--- a/vendors/tezos-modded/dune
+++ /dev/null
@@ -1,13 +0,0 @@
-(env
- (dev
- (flags (:standard)))
- (release
- (flags (:standard -O3))))
-
-(alias
- (name runtest)
- (deps (alias_rec runtest_indent)))
-
-(alias
- (name runtest)
- (deps (alias_rec runtest_sandbox)))
diff --git a/vendors/tezos-modded/dune-workspace b/vendors/tezos-modded/dune-workspace
deleted file mode 100644
index de4fc2092..000000000
--- a/vendors/tezos-modded/dune-workspace
+++ /dev/null
@@ -1 +0,0 @@
-(lang dune 1.0)
diff --git a/vendors/tezos-modded/emacs/README.md b/vendors/tezos-modded/emacs/README.md
deleted file mode 100644
index df817a2bd..000000000
--- a/vendors/tezos-modded/emacs/README.md
+++ /dev/null
@@ -1,65 +0,0 @@
-# Michelson Emacs mode
-This mode is a work in progress.
-Please contact us with bugs and feature requests.
-All of the options mentioned below are also accessible via the customize menu.
-
-## Dependencies:
-To operate the mode, please install the following dependencies.
-All are available from either melpa, elpa, or marmalade
-and are available under a free software license.
-
-| Package | Package Repository | Sources |
-| -------- | ------------------ | --------------- |
-| deferred | Melpa | https://github.com/kiwanami/emacs-deferred |
-
-## Required Configuration
-To use the mode, you must load the `michelson-mode.el` file into Emacs.
-Add the following to your `.emacs` file.
-```elisp
-(load "~/tezos/tezos/emacs/michelson-mode.el" nil t)
-```
-
-Before using the Emacs mode, you must configure the `michelson-client-command`.
-If you have compiled the Tezos Git repository,
-set this to be the path to the `tezos-client` binary on your system.
-Make sure you have an up to date version of the client compiled.
-You must also start a tezos node to enable typechecking features.
-This option is recommended because it is faster than operating through
-the docker container.
-
-If you wish to run the Emacs mode with the alphanet script,
-use the path of the `alphanet.sh` script, plus the word `client`.
-You must also set the `michelson-alphanet` variable to be `t`.
-If you do not set this option, the mode will not work with the alphanet.
-
-Here are examples of the client configuration:
-### Without the alphanet
-```elisp
-(setq michelson-client-command "~/tezos/tezos/tezos-client")
-(setq michelson-alphanet nil)
-```
-### With the alphanet
-```elisp
-(setq michelson-client-command "~/tezos/alphanet/alphanet.sh client")
-(setq michelson-alphanet t)
-```
-
-## Additional Options
-There are various feature of the Emacs mode you may wish to configure.
-
-### Error display
-When writing a contract, you may wish to disable error display in order to
-avoid the "wrong stack type at end of body" error that is often present.
-This can be done by changing the
-`michelson-print-errors` and `michelson-highlight-errors` options.
-Both of these options also have interactive toggles for easy access.
-
-### Live printing
-You can disable live printing using the `michelson-live-editing` option.
-If this option is disabled, both type and error printing are supressed.
-No background command will be run, limiting the mode to syntax highlighting.
-This command can also be toggled interactively using the
-`michelson-toggle-live-editing` command.
-
-### Faces
-The highlighting colors used can be configured. See the customize menu for details.
diff --git a/vendors/tezos-modded/emacs/michelson-mode.el b/vendors/tezos-modded/emacs/michelson-mode.el
deleted file mode 100644
index 20ce905dc..000000000
--- a/vendors/tezos-modded/emacs/michelson-mode.el
+++ /dev/null
@@ -1,913 +0,0 @@
-;; Major mode for editing Michelson smart contracts.
-
-(require 'cl-lib)
-(require 'deferred)
-(require 'font-lock)
-
-(defvar michelson-mode-hook nil)
-
-(defgroup michelson nil
- "Major mode for editing Michelson smart contracts."
- :prefix "michelson-"
- :group 'languages)
-
-(defgroup michelson-options nil
- "General options for Michelson mode."
- :prefix "michelson-"
- :group 'michelson)
-
-(defcustom michelson-client-command "tezos-client"
- "Path to the `tezos-client' binary."
- :type 'string
- :group 'michelson-options)
-
-(defcustom michelson-alphanet nil
- "Is the client command currently using the alphanet.sh script?"
- :type 'boolean
- :group 'michelson-options)
-
-(defgroup michelson-faces nil
- "Font lock faces for Michelson mode."
- :prefix "michelson-"
- :group 'michelson
- :group 'faces)
-
-(defcustom michelson-live-editing t
- "Toggles live types and error printing.
-Overrides `michelson-print-errors' and `michelson-highlight-errors'"
- :group 'michelson-options)
-
-(defcustom michelson-print-errors t
- "Print the errors in the output buffer."
- :type 'boolean
- :group 'michelson-options)
-
-(defcustom michelson-highlight-errors t
- "Highlight errors in the source buffer."
- :type 'boolean
- :group 'michelson-options)
-
-(defvar michelson-face-instruction
- 'michelson-face-instruction
- "Face name for Michelson instructions.")
-(defface michelson-face-instruction
- '((t (:inherit font-lock-keyword-face)))
- "Face for Michelson instructions."
- :group 'michelson-faces)
-
-(defvar michelson-face-type
- 'michelson-face-type
- "Face name for Michelson types.")
-(defface michelson-face-type
- '((t (:inherit font-lock-type-face)))
- "Face for Michelson types."
- :group 'michelson-faces)
-
-(defvar michelson-face-constant
- 'michelson-face-constant
- "Face name for Michelson constants.")
-(defface michelson-face-constant
- '((t (:inherit font-lock-constant-face)))
- "Face for Michelson constants."
- :group 'michelson-faces)
-
-(defvar michelson-face-var-annotation
- 'michelson-face-var-annotation
- "Face name for Michelson variable or binding annotations.")
-(defface michelson-face-var-annotation
- '((t (:inherit font-lock-variable-name-face)))
- "Face for Michelson variable or binding annotations."
- :group 'michelson-faces)
-
-(defvar michelson-face-type-annotation
- 'michelson-face-type-annotation
- "Face name for Michelson type or field annotations.")
-(defface michelson-face-type-annotation
- '((t (:inherit font-lock-string-face)))
- "Face for Michelson type or field annotations."
- :group 'michelson-faces)
-
-(defvar michelson-face-comment
- 'michelson-face-comment
- "Face name for Michelson comments.")
-(defface michelson-face-comment
- '((t (:inherit font-lock-comment-face)))
- "Face for Michelson comments."
- :group 'michelson-faces)
-
-(defvar michelson-face-declaration
- 'michelson-face-declaration
- "Face name for Michelson declarations.")
-
-(defface michelson-face-declaration
- '((t (:inherit font-lock-keyword-face)))
- "Face for Michelson constants."
- :group 'michelson-faces)
-
-(defvar michelson-face-error
- 'michelson-face-error
- "Face name for Michelson comments.")
-
-(defface michelson-face-error
- '(( ((class color) (background light)) (:background "MistyRose") )
- ( ((class color) (background dark)) (:background "DarkRed") ))
- "Face for Michelson annotations."
- :group 'michelson-faces)
-
-(defface michelson-stack-highlight-face
- '(( ((class color) (background light)) (:background "gray86") )
- ( ((class color) (background dark)) (:background "grey21") ))
- "Face for alternating lines of the stack."
- :group 'michelson-faces)
-
-(defun michelson-customize-options ()
- "Open the general customization group for Michelson mode."
- (interactive)
- (customize-group-other-window `michelson-options))
-
-(defun michelson-customize-faces ()
- "Open the face customization group for Michelson mode."
- (interactive)
- (customize-group-other-window `michelson-faces))
-
-(defun michelson-toggle-print-errors ()
- (interactive)
- (setq michelson-print-errors (not michelson-print-errors)))
-
-(defun michelson-highlight-errors ()
- (interactive)
- (setq michelson-highlight-errors (not michelson-highlight-errors)))
-
-(defconst michelson-mode-map
- (let ((michelson-mode-map (make-sparse-keymap)))
- ;; menu
- (define-key michelson-mode-map
- [menu-bar michelson-menu]
- (cons "Michelson" (make-sparse-keymap "michelson-menu")))
- (define-key michelson-mode-map
- [menu-bar michelson-menu faces]
- (cons "Display options group" 'michelson-customize-faces))
- (define-key michelson-mode-map
- [menu-bar michelson-menu options]
- (cons "General options group" 'michelson-customize-options))
- (define-key michelson-mode-map
- [menu-bar michelson-menu separator]
- '(menu-item "--"))
- (define-key michelson-mode-map
- [menu-bar michelson-menu what]
- (cons "What's under the cursor?" 'michelson-type-at-point))
- ;; keys
- (define-key michelson-mode-map
- (kbd "C-j") 'newline-and-indent)
- (define-key michelson-mode-map
- (kbd "TAB") 'indent-for-tab-command)
- (define-key michelson-mode-map
- (kbd "") 'michelson-type-at-point)
- michelson-mode-map))
-
-(defun michelson-font-lock-syntactic-face-function (s)
- (cond ((nth 3 s) 'font-lock-constant-face)
- (t 'michelson-face-comment)))
-
-(defconst michelson-font-lock-defaults
- (list
- (list
- '("\\<[@]\\(\\|%\\|%%\\|[A-Za-z-_][A-Za-z-_0-9\.]*\\)\\>" . michelson-face-var-annotation)
- '("\\<[%:]\\(\\|@\\|[A-Za-z-_][A-Za-z-_0-9\.]*\\)\\>" . michelson-face-type-annotation)
- '("\\<[0-9]+\\>" . michelson-face-constant)
- '("\\<[A-Z][a-z_0-9]+\\>" . michelson-face-constant)
- '("\\<[A-Z][A-Z_0-9]*\\>" . michelson-face-instruction)
- ;; This will have problems if users have whitespace in front of the declarations
- '("^parameter\\|^return\\|^storage\\|^code" . michelson-face-declaration)
- '("\\<[a-z][a-z_0-9]*\\>" . michelson-face-type))
- nil nil nil nil
- '(font-lock-syntactic-face-function . michelson-font-lock-syntactic-face-function)))
-
-(defconst michelson-mode-syntax-table
- (let ((michelson-mode-syntax-table (make-syntax-table)))
- (modify-syntax-entry ?_ "w" michelson-mode-syntax-table)
- (modify-syntax-entry ?@ "w" michelson-mode-syntax-table)
- (modify-syntax-entry ?: "w" michelson-mode-syntax-table)
- (modify-syntax-entry ?% "w" michelson-mode-syntax-table)
- (modify-syntax-entry ?/ ". 1n4" michelson-mode-syntax-table)
- (modify-syntax-entry ?* ". 23" michelson-mode-syntax-table)
- (modify-syntax-entry ?# "b" michelson-mode-syntax-table)
- michelson-mode-syntax-table))
-
-(defun in-space ()
- (or (looking-at "[[:space:]\n]")
- (equal (get-text-property (point) 'face)
- 'michelson-face-comment)))
-
-(defun michelson-goto-previous-token ()
- (interactive)
- (if (bobp)
- (cons 0 nil)
- (progn
- (backward-char 1)
- (while (and (not (bobp)) (in-space)) (backward-char 1))
- (let ((token-face (get-text-property (point) 'face)))
- (forward-char 1)
- (let ((end-of-token (point)))
- (backward-char 1)
- (unless (looking-at "[{()};]")
- (while (and (not (bobp))
- (equal (get-text-property (point) 'face) token-face))
- (backward-char 1))
- (when (not (equal (get-text-property (point) 'face) token-face))
- (forward-char 1)))
- (cons (point) (buffer-substring-no-properties (point) end-of-token)))))))
-
-(defun michelson-goto-next-token ()
- (interactive)
- (if (eobp)
- (cons (point) nil)
- (progn
- (while (and (not (eobp)) (in-space)) (forward-char 1))
- (let ((token-face (get-text-property (point) 'face)))
- (let ((start-of-token (point)))
- (if (looking-at "[{()};]")
- (forward-char 1)
- (progn
- (while (and (not (eobp))
- (equal (get-text-property (point) 'face) token-face))
- (forward-char 1))))
- (cons start-of-token (buffer-substring-no-properties start-of-token (point))))))))
-
-(defun michelson-goto-opener ()
- (interactive)
- (let ((paren-level 0))
- (while (and (not (bobp))
- (or (> paren-level 0)
- (not (looking-at "[{(]"))))
- (cond ((looking-at "[{(]")
- (setq paren-level (- paren-level 1)))
- ((looking-at "[})]")
- (setq paren-level (+ paren-level 1))))
- (michelson-goto-previous-token))
- (cons (point)
- (when (looking-at "[{(]")
- (buffer-substring-no-properties (point) (+ (point) 1))))))
-
-(defun michelson-goto-closer ()
- (interactive)
- (let ((paren-level 0) (last-token ""))
- (while (and (not (eobp))
- (or (> paren-level 0)
- (not (string-match "[)}]" last-token))))
- (cond ((looking-at "[{(]")
- (setq paren-level (+ paren-level 1)))
- ((looking-at "[})]")
- (setq paren-level (- paren-level 1))))
- (setq last-token (cdr (michelson-goto-next-token))))
- (cons (point)
- (when (looking-at "[)}]")
- (buffer-substring-no-properties (point) (+ (point) 1))))))
-
-(defun michelson-goto-previous-application-start ()
- (interactive)
- (let ((paren-level 0) (application-start 0))
- (while (and (not (bobp))
- (or (> paren-level 0)
- (not (looking-at "[{(;]"))))
- (cond ((looking-at "[{(]")
- (setq paren-level (- paren-level 1)))
- ((looking-at "[})]")
- (setq paren-level (+ paren-level 1))))
- (setq application-start (point))
- (michelson-goto-previous-token))
- (cons application-start (goto-char application-start))))
-
-(defun michelson-indent ()
- "Indent current line of Michelson code."
- (interactive)
- (let ((new-indentation 0)
- (previous-indentation (current-indentation))
- (previous-column (current-column))
- (current-token
- (save-excursion
- (beginning-of-line 1)
- (michelson-goto-next-token))))
- (save-excursion
- (end-of-line 0)
- (let ((previous-token
- (save-excursion (michelson-goto-previous-token)))
- (previous-opener
- (save-excursion (michelson-goto-opener))))
- (cond ((and (not (cdr previous-opener))
- (not (cdr previous-token)))
- (setq new-indentation 0))
- ((and (not (cdr previous-opener))
- (equal (cdr previous-token) ";"))
- (setq new-indentation 0))
- ((not (cdr previous-opener))
- (setq new-indentation 2))
- ((and (equal (cdr current-token) "}")
- (equal (cdr previous-opener) "{"))
- (goto-char (car previous-opener))
- (setq new-indentation (current-column)))
- ((and (or (equal (cdr previous-token) ";")
- (equal (cdr previous-token) "{"))
- (equal (cdr previous-opener) "{"))
- (goto-char (car previous-opener))
- (setq new-indentation (+ (current-column) 2)))
- ((equal (cdr previous-opener) "{")
- (progn
- (michelson-goto-previous-application-start)
- (let ((default-param-indentation
- (+ (current-column) 2))
- (first-param-point
- (save-excursion
- (michelson-goto-next-token)
- (car (michelson-goto-next-token)))))
- (if (= first-param-point (car current-token))
- (setq new-indentation default-param-indentation)
- (progn
- (goto-char first-param-point)
- (setq new-indentation (current-column)))))))
- ((and (equal (cdr current-token) ")")
- (equal (cdr previous-opener) "("))
- (goto-char (car previous-opener))
- (setq new-indentation (current-column)))
- ((equal (cdr previous-token) "(")
- (goto-char (car previous-token))
- (setq new-indentation (+ (current-column) 1)))
- ((equal (cdr previous-opener) "(")
- (goto-char (car previous-opener))
- (setq new-indentation (+ (current-column) 3))))))
- (indent-line-to new-indentation)
- (beginning-of-line)
- (forward-char
- (+ (- previous-column previous-indentation) new-indentation))
- (when (< (current-column) new-indentation)
- (beginning-of-line)
- (forward-char new-indentation))))
-
-(defun michelson-token-at-point ()
- "Display the token closest to the cursor."
- (interactive)
- (let ((message
- (cdr (save-excursion
- (michelson-goto-next-token)
- (michelson-goto-previous-token)))))
- (display-message-or-buffer message "*Michelson*")))
-
-(cl-defstruct cache
- "Cache for types. Invalid entries are removed"
- types
- errors)
-
-(defvar michelson-cached-buffer-info (make-cache :types '() :errors '()))
-
-(defvar michelson-process-output-buffer "*Michelson-process*")
-
-(defun michelson-erase-process-buffer ()
- "Remove all text from process buffer."
- (get-buffer-create michelson-process-output-buffer)
- (with-current-buffer michelson-process-output-buffer
- (erase-buffer)))
-
-(defun michelson-async-command-to-string (command callback)
- "Asynchronously execute `COMMAND' and call the `CALLBACK' on the resulting string."
- (lexical-let ((command command)
- (callback-fun callback))
- (deferred:$
- (deferred:$
- (apply 'deferred:process command)
- (deferred:nextc it callback-fun))
- ;; TODO: make this show only the client error
- (deferred:error it (lambda (err) (michelson-write-output-buffer (cadr err)))))))
-
-(defun michelson-clean-cache ()
- "Clean the buffer's program info cache."
- (let ((types (cache-types michelson-cached-buffer-info))
- (errors (cache-errors michelson-cached-buffer-info))
- (clean-cache-entry
- (lambda (alist)
- (remove-if (lambda (entry)
- (let ((tok-end (cadr entry)))
- (> tok-end (point))))
- alist))))
- (setq michelson-cached-buffer-info
- (make-cache :types (funcall clean-cache-entry types)
- :errors (funcall clean-cache-entry errors)))))
-
-(defun michelson-get-info (buffer-name)
- "Refresh the info about the program in `BUFFER-NAME' from the command."
- (lexical-let ((tmp-file (make-temp-file buffer-name)))
- (write-region (point-min) (point-max) tmp-file nil 'no-message)
- (let ((command
- (append (split-string michelson-client-command " ")
- (list
- "typecheck"
- "script"
- (if michelson-alphanet
- (concat "container:" tmp-file)
- tmp-file)
- "-details"
- "--emacs"))))
- (michelson-async-command-to-string
- command
- (lambda (output)
- (condition-case err
- (let*
- ((record (car (read-from-string output)))
- (errors (cdr (assoc 'errors record)))
- (types (cdr (assoc 'types record))))
- (setq michelson-cached-buffer-info (make-cache :types types :errors errors))
- (delete-file tmp-file))
- ((error err)
- (let ((inhibit-message t))
- (message output)))))))))
-
-(defvar michelson-output-buffer-name
- "*Michelson*")
-
-(defun michelson-output-width ()
- (lexical-let* ((buffer (get-buffer-create michelson-output-buffer-name))
- (message-window
- (if (get-buffer-window buffer)
- (get-buffer-window buffer)
- (display-buffer-below-selected buffer nil))))
- (window-body-width message-window)))
-
-(defvar michelson-output-buffer-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map special-mode-map)
- (define-key map "g" nil)
- map)
- "Keymap for types buffer.")
-
-(define-derived-mode michelson-stack-mode fundamental-mode "Michelson-stack"
- "Major mode for visualizing the Michelson stack."
- (interactive)
- (use-local-map michelson-output-buffer-map)
- (set-syntax-table michelson-mode-syntax-table)
- (set
- (make-local-variable 'font-lock-defaults)
- michelson-font-lock-defaults)
- (setq major-mode 'michelson-stack-mode)
- (setq mode-name "Michelson-stack")
- (setq indent-tabs-mode nil))
-
-(defun michelson-write-output-buffer (data &optional do-not-overwrite)
- "Write the given `DATA' to the output buffer.
-If `DATA' is a string, it is written directly,
-overwriting the data in the buffer.
-If `DATA' is a list of strings, the strings are written into the buffer,
-with alternating lines highlighted.
-If `DO-NOT-OVERWRITE' is non-nil, the existing contents of the buffer are maintained."
- (lexical-let*
- ((buffer (get-buffer-create michelson-output-buffer-name))
- (message-window
- (if (get-buffer-window buffer)
- (get-buffer-window buffer)
- (display-buffer-below-selected buffer nil)))
- (lines 0))
- (when (get-buffer-window buffer)
- (set-window-dedicated-p (get-buffer-window buffer) t))
- (save-excursion
- (set-buffer michelson-output-buffer-name)
- (read-only-mode -1)
- (unless do-not-overwrite
- (erase-buffer))
- (goto-char (point-min))
- (remove-overlays)
- (if (listp data)
- (lexical-let ((michelson-highlighting t))
- (dolist (ele (reverse data))
- (lexical-let ((prev-point (point)))
- (insert ele)
- (when michelson-highlighting
- (overlay-put (make-overlay prev-point (point))
- 'face 'michelson-stack-highlight-face))
- (setq michelson-highlighting (not michelson-highlighting)))))
- (insert data))
- (with-current-buffer buffer (michelson-stack-mode))
- (read-only-mode 1)
- (goto-char (point-min))
- (while (not (eobp))
- (vertical-motion 1)
- (setq lines (+ 1 lines)))
- (window-resize
- message-window
- (min (- (window-total-height) 5)
- (+ (- (max 4 lines)
- (window-size message-window))
- 2))))))
-
-(defun michelson-format-stack-top (bef-ele aft-ele width)
- (lexical-let*
- ((pp-no-trailing-newline
- (lambda (sexp)
- (let* ((str (replace-regexp-in-string "\\\\\." "." (pp-to-string sexp)))
- (len (length str)))
- (if (equal "\n" (substring str (- len 1) len))
- (substring str 0 (- len 1))
- str))))
- (bef-strs (if bef-ele (split-string (funcall pp-no-trailing-newline bef-ele) "\n") '("")))
- (aft-strs (if aft-ele (split-string (funcall pp-no-trailing-newline aft-ele) "\n") '("")))
- (width width))
- (letrec ((format-strings
- (lambda (befs afts)
- (if (or befs afts)
- (let ((aft-stack (if afts (car afts) "")))
- (concat (format (format "%%-%ds|%s%%s\n"
- (/ width 2)
- (if (equal aft-stack "") "" " "))
- (if befs (car befs) "")
- aft-stack)
- (funcall format-strings (cdr befs) (cdr afts))))
- ""))))
- (funcall format-strings bef-strs aft-strs))))
-
-
-(defun michelson-format-stacks (bef-stack aft-stack)
- (letrec ((michelson-format-stacks-help
- (lambda (bef aft)
- (if (or bef aft)
- (cons (michelson-format-stack-top (car bef) (car aft) (michelson-output-width))
- (funcall michelson-format-stacks-help (cdr bef) (cdr aft)))
- '()))))
- (funcall michelson-format-stacks-help (reverse bef-stack) (reverse aft-stack))))
-
-(cl-defstruct michelson-stacks
- "A pair of stacks, from `BEF' (before) and `AFT' (after) the instruction"
- bef
- aft)
-
-(defun michelson-get-previous-stack ()
- (save-excursion
- (michelson-goto-previous-token)
- (lexical-let ((stacks nil)
- (brace-count 0)
- (break nil))
- (while (and (not break)
- (not stacks)
- (> (point) 0)
- (>= brace-count 0))
- (backward-char)
- (cond ((and (equal (get-text-property (point) 'face)
- 'michelson-face-instruction)
- (= brace-count 0))
- (setq break t)
- (setq stacks (michelson-stacks-at-loc (point))))
- ((equal (string (char-after (point))) "{")
- (setq brace-count (- brace-count 1)))
- ((equal (string (char-after (point))) "}")
- (setq brace-count (+ brace-count 1)))
- (t nil)))
- stacks)))
-
-
-(defun michelson-completion-at-point ()
- (let ((prev-stack (michelson-get-previous-stack)))
- (if prev-stack
- (let* ((bds (bounds-of-thing-at-point 'word))
- (start (car bds))
- (end (cdr bds))
- (completion-stack (michelson-stacks-aft prev-stack))
- (instrs (michelson-get-suggestion-list completion-stack)))
- (list start end instrs . nil))
- nil)))
-
-(defun michelson-stacks-at-loc (loc)
- (let ((types-info nil))
- (dolist (elt (cache-types michelson-cached-buffer-info))
- (when (and (<= (car elt) loc) (<= loc (cadr elt))
- (equal (get-text-property loc 'face)
- 'michelson-face-instruction))
- (setq types-info (make-michelson-stacks :bef (caddr elt)
- :aft (cadddr elt)))))
- types-info))
-
-(defun michelson-show-program-info ()
- "Show the program's `TYPES' and `ERRORS'."
- (interactive)
- (remove-overlays)
- (lexical-let* ((stacks (michelson-stacks-at-loc (point)))
- (types-info (and stacks (michelson-format-stacks (michelson-stacks-bef stacks)
- (michelson-stacks-aft stacks))))
- (errors-info nil))
- (when michelson-highlight-errors
- (dolist (elt (cache-errors michelson-cached-buffer-info))
- (overlay-put (make-overlay (car elt) (cadr elt)) 'face 'michelson-face-error)
- (when (and (<= (car elt) (point)) (<= (point) (cadr elt)))
- (progn
- (when michelson-print-errors
- (unless errors-info
- (setq errors-info (concat errors-info "\n")))
- (setq errors-info (concat errors-info (cadr (cdr elt)))))))))
- (cond ((and types-info errors-info)
- (michelson-write-output-buffer errors-info nil)
- (michelson-write-output-buffer types-info t))
- (types-info
- (michelson-write-output-buffer types-info nil))
- (errors-info
- (michelson-write-output-buffer errors-info nil))
- (t (michelson-write-output-buffer "\nNo information available at point")))))
-
-(defun michelson-type-at-point ()
- "Display the type of the expression under the cursor."
- (interactive)
- (michelson-get-info (buffer-name))
- (michelson-show-program-info))
-
-(defun michelson-make-suggest (instr pred)
- "Suggest `INSTR' if `PRED' is not nil."
- (lexical-let ((instr instr)
- (pred pred))
- (lambda (stack)
- (if (funcall pred stack)
- (if (listp instr)
- instr
- `(,instr))
- nil))))
-
-
-(defun michelson-constrained-p (var hash)
- (not (equal var (gethash var hash var))))
-
-(defun michelson-polymorphic-match (tbl match-types stack)
- (cond ((not match-types) t)
- ((not stack) nil)
- ((and (consp match-types) (consp stack))
- (and (michelson-polymorphic-match tbl (car match-types) (car stack))
- (michelson-polymorphic-match tbl (cdr match-types) (cdr stack))))
- ((and (symbolp match-types) (symbolp stack))
- (if (and (michelson-constrained-p match-types tbl)
- (gethash match-types tbl))
- (equal (gethash match-types tbl nil) stack)
- (progn
- (puthash match-types stack tbl)
- t)))
- (t nil)))
-
-(defmacro forall (vars matching-stack)
- (unless (listp ',vars)
- (error "forall must take a list of vars"))
- `(lambda (stack)
- (let ((tbl (make-hash-table :test 'equal)))
- ,@(mapcar (lambda (var) `(puthash ',var ',var tbl)) vars)
- (michelson-polymorphic-match tbl ',matching-stack stack))))
-
-(defun michelson-literals-match-p (types)
- "Generate a predicate that matches `TYPES' against the top of the stack."
- (lexical-let ((types types))
- (lambda (stack)
- (michelson-polymorphic-match
- (make-hash-table :test 'equal)
- types
- stack))))
-
-(defun michelson-suggest-literals (instr &rest types)
- "Suggest `INSTR' when `TYPES' are on the top of the stack."
- (michelson-make-suggest
- instr
- (michelson-literals-match-p types)))
-
-
-(defun michelson-suggest-or (instr pred1 pred2)
- (lexical-let ((pred1 pred1)
- (pred2 pred2))
- (michelson-make-suggest
- instr
- (lambda (stack) (or (funcall pred1 stack) (funcall pred2 stack))))))
-
-(defun michelson-suggest-reorderable (instr type1 type2)
- (michelson-suggest-or instr
- (michelson-literals-match-p `(,type1 ,type2))
- (michelson-literals-match-p `(,type2 ,type1))))
-
-(defvar michelson-suggest-always-available
- '("FAIL" "PUSH" "UNIT" "LAMBDA" "NONE"
- "EMPTY_SET" "EMPTY_MAP" "NIL" "BALANCE"
- "AMOUNT" "STEPS_TO_QUOTA" "NOW"))
-
-(defun michelson-comparable-p (type)
- "Is the `TYPE' comparable?"
- (memq type '(int nat string tez bool key timestamp)))
-
-
-(defun michelson-suggest-pairs-help (pair-type accessor-prefix)
- "Suggest all possible pair accessors on the given `PAIR-TYPE' and `ACCESSOR-PREFIX'."
- (cons (concat accessor-prefix "R")
- (if (and (consp pair-type) (equal (car pair-type) 'pair))
- (let ((car-ele (cadr pair-type))
- (cdr-ele (caddr pair-type)))
- (append
- (michelson-suggest-pairs-help car-ele
- (concat accessor-prefix "A"))
- (michelson-suggest-pairs-help car-ele
- (concat accessor-prefix "D"))
- '())))))
-
-(defun michelson-suggest-pairs (stack)
- "Suggest all possible pair accessors on the given `STACK'."
- (if (and (consp (car stack)) (equal (caar stack) 'pair))
- (append (michelson-suggest-pairs-help (cadar stack) "CA")
- (michelson-suggest-pairs-help (caddar stack) "CD")
- nil)))
-
-(defconst michelson-comparison-operations
- '("EQ" "NEQ" "LT" "LE" "GT" "GE"))
-
-(defun michelson-suggest-comparable (stack)
- (let ((first (car stack))
- (second (cadr stack)))
- (if (and first
- second
- (michelson-comparable-p first)
- (equal first second))
- (cons
- "COMPARE"
- (append
- (mapcar (lambda (x) (concat "CMP" x))
- michelson-comparison-operations)
- (mapcar (lambda (x) (concat "IFCMP" x))
- michelson-comparison-operations)))
- '())))
-
-(defun michelson-suggest-depth (instrs depth)
- "Suggest `INSTRS' if the stack depth is greater than or equal to `DEPTH'."
- (michelson-make-suggest
- instrs
- (lexical-let ((depth depth))
- (lambda (stack) (>= (length stack) depth)))))
-
-(defun michelson-suggest-prefix-depth (prefix additional suffix)
- (lexical-let ((prefix prefix)
- (additional additional)
- (suffix suffix))
- (lambda (stack)
- (reverse (car (reduce
- (lambda (acc ele)
- (lexical-let ((existing (car acc))
- (prefix (concat (cdr acc) additional)))
- (cons (cons (concat prefix suffix) existing)
- prefix)))
- stack
- :initial-value (cons nil "D")))))))
-
-(defvar michelson-type-completion-list
- (list
- (michelson-make-suggest "EXEC" (forall (arg ret) (arg (lambda arg ret))))
- (michelson-make-suggest "MEM" (forall (val-type) (val-type (set val-type))))
- (michelson-make-suggest "MEM" (forall (key-type val-type) (key-type (map key-type val-type))))
- (michelson-make-suggest "UPDATE" (forall (val-type) (val-type bool (set val-type))))
- (michelson-make-suggest "UPDATE" (forall (key-type val-type)
- (key-type (option val-type) (map key-type val-type))))
- (michelson-make-suggest "MAP" (forall (lt rt) ((lambda lt rt) (list lt))))
- (michelson-make-suggest "MAP" (forall (k v b) ((lambda (pair k v) b) (map k v))))
- (michelson-suggest-literals "IF" 'bool)
- (michelson-suggest-literals "LOOP" 'bool)
- (michelson-suggest-literals michelson-comparison-operations 'int)
- 'michelson-suggest-comparable
- 'michelson-suggest-pairs
- (michelson-suggest-prefix-depth "D" "I" "P")
- (michelson-suggest-prefix-depth "D" "U" "P")
- (lambda (stack) (and (cdr stack)
- (funcall (michelson-suggest-prefix-depth "PA" "A" "IP") (cdr stack))))
- (michelson-suggest-literals "NOT" 'bool)
- (michelson-suggest-literals '("OR" "AND" "XOR") 'bool 'bool)
- (michelson-suggest-literals "ABS" 'int)
- (michelson-make-suggest
- '("ADD" "SUB" "MUL" "EDIV")
- (lambda (stack)
- (let ((first (car stack))
- (second (cadr stack))
- (intnat '(int nat)))
- (and first
- second
- (memq first intnat)
- (memq second intnat)))))
- (michelson-suggest-reorderable "ADD" 'nat 'timestamp)
- (michelson-suggest-literals "NOT" 'int)
- (michelson-suggest-literals '("OR" "AND" "XOR" "LSL" "LSR") 'nat 'nat)
- (michelson-suggest-literals '("CONCAT") 'string 'string)
- (michelson-suggest-depth '("SOME" "LEFT" "RIGHT") 1)
- (michelson-suggest-literals '("ADD" "SUB") 'tez 'tez)
- (michelson-suggest-reorderable '("ADD" "SUB" "MUL") 'tez 'nat)
- (michelson-suggest-literals "EDIV" 'tez 'nat)
- (michelson-suggest-literals "EDIV" 'tez 'tez)
- (michelson-suggest-literals "IMPLICIT_ACCOUNT" 'key)
- (michelson-suggest-depth "SWAP" 2)
- (michelson-suggest-depth '("DROP" "H") 1)
- (michelson-suggest-literals "CHECK_SIGNATURE" 'key '(pair signature string))
- (michelson-suggest-literals "CREATE_ACCOUNT" 'key '(option key) 'bool 'tez)
- (michelson-make-suggest "IF_NONE" (forall (x) (option x)))
- (michelson-make-suggest "IF_LEFT" (forall (x y) (or x y)))
- ;; This is not exactly the type of TRANSFER_TOKENS.
- ;; It will be changed once the concurrency model is worked out
- (michelson-make-suggest "TRANSFER_TOKENS" (forall (p r g) (p tez (contract p r) g)))
- (michelson-make-suggest
- "CREATE_CONTRACT"
- (forall (p r g) (key (option key) bool bool tez (lambda (pair p g) (pair r g)) g)))
- (michelson-make-suggest "MANAGER" (forall (p r) ((contract p r))))
- (michelson-make-suggest "CONS" (forall (a) (a (list a))))
- (michelson-make-suggest "IF_CONS" (forall (a) (list a)))
- (michelson-make-suggest "GET" (forall (k v) (k (map k v))))
- (michelson-make-suggest "UPDATE" (forall (v) (v bool (set v))))
- (michelson-make-suggest "UPDATE" (forall (k v) (k (option v) (map k v))))
- (michelson-make-suggest "REDUCE" (forall (elt b) ((lambda (pair elt b) b) (set elt) b)))
- (michelson-make-suggest "REDUCE" (forall (key val b) ((lambda (pair (pair key val) b) b) (map key val) b)))
- (michelson-make-suggest "REDUCE" (forall (a b) ((lambda (pair a b) b) (list a) b)))
-
-
-))
-
-;; Special handling
-;; PA+IR
-
-
-(defun michelson-get-suggestion-list (stack)
- (lexical-let ((stack stack))
- (reduce (lambda (func acc) (append (funcall func stack) acc))
- michelson-type-completion-list
- :from-end t
- :initial-value michelson-suggest-always-available)))
-
-
-(defun michelson-toggle-live-editing ()
- "Toggle `michelson-live-editing'.
-Enables or disables stack and error display."
- (interactive)
- (when (and michelson-live-editing
- (get-buffer michelson-output-buffer-name))
- (save-excursion
- (set-buffer michelson-output-buffer-name)
- (kill-buffer-and-window)))
- (setq michelson-live-editing (not michelson-live-editing)))
-
-
-(defun michelson-update-minibuffer-info ()
- (when (nth 2 michelson-state)
- (cancel-timer (nth 2 michelson-state)))
- (setf
- (nth 2 michelson-state)
- (run-at-time
- "0.3 sec" nil
- (lambda (buffer)
- (with-current-buffer buffer
- (setf (nth 2 michelson-state) nil)
- (when (and (not (= (nth 0 michelson-state) (point)))
- michelson-live-editing)
- (setf (nth 0 michelson-state) (point))
- (michelson-type-at-point))))
- (current-buffer))))
-
-(defun michelson-close-output-buffer ()
- "Close the interactive editing buffer."
- (interactive)
- (let ((buffer (get-buffer michelson-output-buffer-name)))
- (when buffer
- (let ((window (get-buffer-window buffer)))
- (if window (quit-window t window) (kill-buffer buffer))))))
-
-(define-derived-mode michelson-mode prog-mode "Michelson"
- "Major mode for editing Michelson smart contracts."
- (interactive)
- (kill-all-local-variables)
- (use-local-map michelson-mode-map)
- (set-syntax-table michelson-mode-syntax-table)
- (set
- (make-local-variable 'font-lock-defaults)
- michelson-font-lock-defaults)
- (set
- (make-local-variable 'indent-line-function)
- 'michelson-indent)
- (set
- (make-local-variable 'indent-for-tab-command)
- 'michelson-indent)
- (set
- (make-local-variable 'michelson-state)
- (list 0 0 nil))
- (set (make-local-variable 'michelson-cached-buffer-info)
- (make-cache :types nil
- :errors nil))
- (add-to-list
- (make-local-variable 'pre-command-hook)
- 'michelson-update-minibuffer-info)
- (add-to-list
- (make-local-variable 'focus-in-hook)
- 'michelson-update-minibuffer-info)
- (add-hook 'post-self-insert-hook 'michelson-clean-cache)
- (add-hook 'kill-buffer-hook 'michelson-close-output-buffer t t)
- (setq major-mode 'michelson-mode)
- (setq mode-name "Michelson")
- (setq indent-tabs-mode nil)
- (setq show-trailing-whitespace t)
- (setq buffer-file-coding-system 'utf-8-unix)
- (add-hook 'completion-at-point-functions 'michelson-completion-at-point nil 'local)
- (setq-local company-backends '(company-capf))
- (setq-local process-environment
- (cons "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER=Y"
- (cons "ALPHANET_EMACS=true"
- (cons "TEZOS_ALPHANET_DO_NOT_PULL=yes"
- process-environment))))
- (run-hooks 'michelson-mode-hook))
-(add-to-list 'auto-mode-alist '("\\.tz\\'" . michelson-mode))
-(add-to-list 'auto-mode-alist '("\\.tez\\'" . michelson-mode))
-
-(provide 'michelson-mode)
diff --git a/vendors/tezos-modded/scripts/activate_protocol.sh b/vendors/tezos-modded/scripts/activate_protocol.sh
deleted file mode 100755
index f72b2e5cd..000000000
--- a/vendors/tezos-modded/scripts/activate_protocol.sh
+++ /dev/null
@@ -1,89 +0,0 @@
-#! /bin/bash
-
-set -e
-
-usage="Usage:
-$ ./scripts/activate_protocol.sh src/proto_004_PtDPBVyN
-Inserts the protocol in the right files of the build system to compile it
-If in master activates in addition to alpha.
-If in mainnet activates in addition to its predecessor, here proto_003_PsddFKi3."
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-cd "$script_dir"/..
-
-if [ ! -d "$1" ]; then
- echo "$usage"
- exit 1
-fi
-
-is_mainnet () {
- # need to check a real file because of phantom git directories
- if [ -f "src/proto_000_Ps9mPmXa/lib_protocol/src/TEZOS_PROTOCOL" ]
- then return 0; else return 1; fi
-}
-
-new_version=$(basename $1 | awk -F'_' '{print $2}')
-new_hash=$(basename $1 | awk -F'_' '{print $3}')
-full_hash=$(jq .hash < $1/lib_protocol/src/TEZOS_PROTOCOL)
-replacement=${new_version}-${new_hash}
-if [[ -z "${new_version}" || -z "${new_hash}" || -z "${full_hash}" ]] ; then
- echo "$usage"
- exit 1
-fi
-
-# The pattern to look for, "alpha" for master or "00X-" for mainnet.
-# Once found it's either replaced or the line is duplicated and then replaced
-if is_mainnet
-then
- old_version=$( printf '%03d' $(($new_version -1)) )
- old_dir=$(ls -d src/proto_${old_version}_*)
- old_hash=$(basename $old_dir | awk -F'_' '{print $3}')
- pattern=${old_version}-${old_hash}
-else
- pattern="alpha"
-fi
-
-# if a line matches PATTERN, a new line is printed where the pattern is replaced
-duplicate_and_replace() {
- PATTERN=$1
- REPLACEMENT=$2
- shift 2
-
- awk -i inplace '{
- print
- if ($0 ~ PATTERN) {
- sub(PATTERN,REPLACEMENT)
- print
- }}' PATTERN=$PATTERN REPLACEMENT=$REPLACEMENT $*
-}
-
-# the minimum needed, although you can't bake
-duplicate_and_replace ${pattern} ${replacement} active_protocol_versions
-
-# activate in client to bake and use RPCs
-duplicate_and_replace -${pattern} -${replacement} \
- src/bin_client/{dune,tezos-client.opam}
-
-read -p "Link in the Node? (no if you want to test injection) (Y/n) " ans
-if [[ "$ans" == "Y" || "$ans" == "y" || -z "$ans" ]]; then
- duplicate_and_replace -${pattern} -${replacement} \
- src/bin_node/{dune,tezos-node.opam}
-fi
-
-read -p "User-activated update in 3 blocks? (Y/n) " ans
-if [[ "$ans" == "Y" || "$ans" == "y" || -z "$ans" ]]; then
- # clean existing lines, if any
- awk -i inplace '
- BEGIN{found=0}{
- if (!found && $0 ~ "let forced_protocol_upgrades")
- {found=1; print}
- else {
- if (found && $0 ~ "^]")
- {found=0; print }
- else
- { if (!found){print}}
- }}' src/lib_base/block_header.ml
-
- sed -i '/let forced_protocol_upgrades/ a \ \ 3l, Protocol_hash.of_b58check_exn '${full_hash}' ;' \
- src/lib_base/block_header.ml
-fi
diff --git a/vendors/tezos-modded/scripts/alphanet.sh b/vendors/tezos-modded/scripts/alphanet.sh
deleted file mode 100755
index 515b9519e..000000000
--- a/vendors/tezos-modded/scripts/alphanet.sh
+++ /dev/null
@@ -1,829 +0,0 @@
-#! /usr/bin/env bash
-
-set -e
-
-if ! which docker > /dev/null 2>&1 ; then
- echo "Docker does not seem to be installed."
- exit 1
-fi
-
-if ! which docker-compose > /dev/null 2>&1 ; then
- echo "Docker-compose does not seem to be installed."
- exit 1
-fi
-
-docker_version="$(docker version -f "{{ .Server.Version }}")"
-docker_major="$(echo "$docker_version" | cut -d . -f 1)"
-docker_minor="$(echo "$docker_version" | cut -d . -f 2)"
-
-if ([ "$docker_major" -gt 1 ] ||
- ( [ "$docker_major" -eq 1 ] && [ "$docker_minor" -ge 13 ] )) ; then
- docker_1_13=true
-else
- docker_1_13=false
-fi
-
-current_dir="$(pwd -P)"
-src_dir="$(cd "$(dirname "$0")" && echo "$current_dir/")"
-cd "$src_dir"
-
-update_compose_file() {
-
- update_active_protocol_version
-
- if [ "$#" -ge 2 ] && [ "$1" = "--rpc-port" ] ; then
- export_rpc="
- - \"$2:8732\""
- shift 2
- fi
-
- cat > "$docker_compose_yml" <> "$docker_compose_yml" < "$active_protocol_versions"
-}
-
-may_update_active_protocol_version() {
- if [ ! -f "$active_protocol_versions" ] ; then
- update_active_protocol_version
- fi
-}
-
-pull_image() {
- if [ "$TEZOS_ALPHANET_DO_NOT_PULL" = "yes" ] \
- || [ "$ALPHANET_EMACS" ] \
- || [ "$docker_image" = "$(echo $docker_image | tr -d '/')" ] ; then
- return ;
- fi
- docker pull "$docker_image"
- update_active_protocol_version
- date "+%s" > "$docker_pull_timestamp"
-}
-
-may_pull_image() {
- if [ ! -f "$docker_pull_timestamp" ] \
- || [ 3600 -le $(($(date "+%s") - $(cat $docker_pull_timestamp))) ]; then
- pull_image
- fi
-}
-
-uptodate_container() {
- running_image=$(docker inspect \
- --format="{{ .Image }}" \
- --type=container "$(container_name "$1")")
- latest_image=$(docker inspect \
- --format="{{ .Id }}" \
- --type=image "$docker_image")
- [ "$latest_image" = "$running_image" ]
-}
-
-uptodate_containers() {
- container=$1
- if [ ! -z "$container" ]; then
- shift 1
- uptodate_container $container && uptodate_containers $@
- fi
-}
-
-assert_container() {
- call_docker_compose up --no-start
-}
-
-container_name() {
- local name="$(docker ps --filter "name=$1" --format "{{.Names}}")"
- if [ -n "$name" ]; then echo "$name"; else echo "$1"; fi
-}
-
-## Node ####################################################################
-
-check_node_volume() {
- docker volume inspect "$docker_node_volume" > /dev/null 2>&1
-}
-
-clear_node_volume() {
- if check_node; then
- echo -e "\033[31mCannot clear data while the node is running.\033[0m"
- exit 1
- fi
- if check_node_volume ; then
- docker volume rm "$docker_node_volume" > /dev/null
- echo -e "\033[32mThe chain data has been removed from the disk.\033[0m"
- else
- echo -e "\033[32mNo remaining data to be removed from the disk.\033[0m"
- fi
-}
-
-check_node() {
- res=$(docker inspect \
- --format="{{ .State.Running }}" \
- --type=container "$(container_name "$docker_node_container")" 2>/dev/null || echo false)
- [ "$res" = "true" ]
-}
-
-assert_node() {
- if ! check_node; then
- echo -e "\033[31mNode is not running!\033[0m"
- exit 0
- fi
-}
-
-warn_node_uptodate() {
- if ! uptodate_container "$docker_node_container"; then
- echo -e "\033[33mThe current node is not the latest available.\033[0m"
- fi
-}
-
-assert_node_uptodate() {
- may_pull_image
- assert_node
- if ! uptodate_container "$docker_node_container"; then
- echo -e "\033[33mThe current node is not the latest available.\033[0m"
- exit 1
- fi
-}
-
-status_node() {
- may_pull_image
- if check_node; then
- echo -e "\033[32mNode is running\033[0m"
- warn_node_uptodate
- else
- echo -e "\033[33mNode is not running\033[0m"
- fi
-}
-
-start_node() {
- pull_image
- if check_node; then
- echo -e "\033[31mNode is already running\033[0m"
- exit 1
- fi
- update_compose_file "$@"
- call_docker_compose up --no-start
- call_docker_compose start node
- echo -e "\033[32mThe node is now running.\033[0m"
-}
-
-log_node() {
- may_pull_image
- assert_node_uptodate
- call_docker_compose logs -f node
-}
-
-stop_node() {
- if ! check_node; then
- echo -e "\033[31mNo node to kill!\033[0m"
- exit 1
- fi
- echo -e "\033[32mStopping the node...\033[0m"
- call_docker_compose stop node
-}
-
-
-## Baker ###################################################################
-
-check_baker() {
- update_active_protocol_version
- bakers="$(sed s/^/baker-/g "$active_protocol_versions")"
- docker_baker_containers="$(sed "s/^\(.*\)$/${docker_compose_name}_baker-\1_1/g" "$active_protocol_versions")"
- res=$(docker inspect \
- --format="{{ .State.Running }}" \
- --type=container "$(container_name "$docker_baker_containers")" 2>/dev/null || echo false)
- [ "$res" = "true" ]
-}
-
-assert_baker() {
- if ! check_baker; then
- echo -e "\033[31mBaker is not running!\033[0m"
- exit 0
- fi
-}
-
-assert_baker_uptodate() {
- assert_baker
- if ! uptodate_containers $docker_baker_containers; then
- echo -e "\033[33mThe current baker is not the latest available.\033[0m"
- exit 1
- fi
-}
-
-status_baker() {
- if check_baker; then
- echo -e "\033[32mBaker is running\033[0m"
- may_pull_image
- if ! uptodate_containers $docker_baker_containers; then
- echo -e "\033[33mThe current baker is not the latest available.\033[0m"
- fi
- else
- echo -e "\033[33mBaker is not running\033[0m"
- fi
-}
-
-start_baker() {
- if check_baker; then
- echo -e "\033[31mBaker is already running\033[0m"
- exit 1
- fi
- pull_image
- assert_node_uptodate
- call_docker_compose start $bakers
- echo -e "\033[32mThe baker is now running.\033[0m"
-}
-
-log_baker() {
- may_pull_image
- assert_baker_uptodate
- call_docker_compose logs -f $bakers
-}
-
-stop_baker() {
- if ! check_baker; then
- echo -e "\033[31mNo baker to kill!\033[0m"
- exit 1
- fi
- echo -e "\033[32mStopping the baker...\033[0m"
- call_docker_compose stop $bakers
-}
-
-## Endorser ###################################################################
-
-check_endorser() {
- update_active_protocol_version
- endorsers="$(sed s/^/endorser-/g "$active_protocol_versions")"
- docker_endorser_containers="$(sed "s/^\(.*\)$/${docker_compose_name}_endorser-\1_1/g" "$active_protocol_versions")"
- res=$(docker inspect \
- --format="{{ .State.Running }}" \
- --type=container "$(container_name "$docker_endorser_containers")" 2>/dev/null || echo false)
- [ "$res" = "true" ]
-}
-
-assert_endorser() {
- if ! check_endorser; then
- echo -e "\033[31mEndorser is not running!\033[0m"
- exit 0
- fi
-}
-
-assert_endorser_uptodate() {
- assert_endorser
- if ! uptodate_containers $docker_endorser_containers; then
- echo -e "\033[33mThe current endorser is not the latest available.\033[0m"
- exit 1
- fi
-}
-
-status_endorser() {
- if check_endorser; then
- echo -e "\033[32mEndorser is running\033[0m"
- may_pull_image
- if ! uptodate_containers $docker_endorser_containers; then
- echo -e "\033[33mThe current endorser is not the latest available.\033[0m"
- fi
- else
- echo -e "\033[33mEndorser is not running\033[0m"
- fi
-}
-
-start_endorser() {
- if check_endorser; then
- echo -e "\033[31mEndorser is already running\033[0m"
- exit 1
- fi
- pull_image
- assert_node_uptodate
- call_docker_compose start $endorsers
- echo -e "\033[32mThe endorser is now running.\033[0m"
-}
-
-log_endorser() {
- may_pull_image
- assert_endorser_uptodate
- call_docker_compose logs -f $endorsers
-}
-
-stop_endorser() {
- if ! check_endorser; then
- echo -e "\033[31mNo endorser to kill!\033[0m"
- exit 1
- fi
- echo -e "\033[32mStopping the endorser...\033[0m"
- call_docker_compose stop $endorsers
-}
-
-## Accuser ###################################################################
-
-check_accuser() {
- update_active_protocol_version
- accusers="$(sed s/^/accuser-/g "$active_protocol_versions")"
- docker_accuser_containers="$(sed "s/^\(.*\)$/${docker_compose_name}_accuser-\1_1/g" "$active_protocol_versions")"
- res=$(docker inspect \
- --format="{{ .State.Running }}" \
- --type=container "$(container_name "$docker_accuser_containers")" 2>/dev/null || echo false)
- [ "$res" = "true" ]
-}
-
-assert_accuser() {
- if ! check_accuser; then
- echo -e "\033[31mAccuser is not running!\033[0m"
- exit 0
- fi
-}
-
-assert_accuser_uptodate() {
- assert_accuser
- if ! uptodate_containers $docker_accuser_containers; then
- echo -e "\033[33mThe current accuser is not the latest available.\033[0m"
- exit 1
- fi
-}
-
-status_accuser() {
- if check_accuser; then
- echo -e "\033[32mAccuser is running\033[0m"
- may_pull_image
- if ! uptodate_containers $docker_accuser_containers; then
- echo -e "\033[33mThe current accuser is not the latest available.\033[0m"
- fi
- else
- echo -e "\033[33mAccuser is not running\033[0m"
- fi
-}
-
-start_accuser() {
- if check_accuser; then
- echo -e "\033[31mAccuser is already running\033[0m"
- exit 1
- fi
- pull_image
- assert_node_uptodate
- call_docker_compose start $accusers
- echo -e "\033[32mThe accuser is now running.\033[0m"
-}
-
-log_accuser() {
- may_pull_image
- assert_accuser_uptodate
- call_docker_compose logs -f $accusers
-}
-
-stop_accuser() {
- if ! check_accuser; then
- echo -e "\033[31mNo accuser to kill!\033[0m"
- exit 1
- fi
- echo -e "\033[32mStopping the accuser...\033[0m"
- call_docker_compose stop $accusers
-}
-
-## Misc ####################################################################
-
-run_client() {
- assert_node_uptodate
- exec_docker "tezos-client" "$@"
-}
-
-run_admin_client() {
- assert_node_uptodate
- exec_docker "tezos-admin-client" "$@"
-}
-
-run_shell() {
- assert_node_uptodate
- if [ $# -eq 0 ]; then
- exec_docker /bin/sh
- else
- exec_docker /bin/sh -c "$@"
- fi
-}
-
-display_head() {
- assert_node_uptodate
- exec_docker tezos-client rpc get /chains/main/blocks/head/header
-}
-
-## Main ####################################################################
-
-start() {
- pull_image
- update_compose_file "$@"
- call_docker_compose up -d --remove-orphans
- warn_script_uptodate
-}
-
-stop() {
- call_docker_compose down
-}
-
-kill_() {
- call_docker_compose kill
- stop
-}
-
-status() {
- status_node
- status_baker
- status_endorser
- warn_script_uptodate verbose
-}
-
-warn_script_uptodate() {
- if [[ $ALPHANET_EMACS ]]; then
- return
- fi
- docker run --entrypoint /bin/cat "$docker_image" \
- "/usr/local/share/tezos/alphanet.sh" > ".alphanet.sh.new"
- if ! diff .alphanet.sh.new "$0" >/dev/null 2>&1 ; then
- echo -e "\033[33mWarning: the container contains a new version of 'alphanet.sh'.\033[0m"
- echo -e "\033[33mYou might run '$0 update_script' to synchronize.\033[0m"
- elif [ "$1" = "verbose" ] ; then
- echo -e "\033[32mThe script is up to date.\033[0m"
- fi
- rm .alphanet.sh.new
-}
-
-update_script() {
- docker run --entrypoint /bin/cat "$docker_image" \
- "/usr/local/share/tezos/alphanet.sh" > ".alphanet.sh.new"
- if ! diff .alphanet.sh.new "$0" >/dev/null 2>&1 ; then
- mv .alphanet.sh.new "$0"
- echo -e "\033[32mThe script has been updated.\033[0m"
- else
- rm .alphanet.sh.new
- echo -e "\033[32mThe script is up to date.\033[0m"
- fi
-}
-
-usage() {
- echo "Usage: $0 [GLOBAL_OPTIONS] [OPTIONS]"
- echo " Main commands:"
- echo " $0 start [--rpc-port ] [OPTIONS]"
- echo " Launch a full Tezos alphanet node in a docker container"
- echo " automatically generating a new network identity."
- echo " OPTIONS (others than --rpc-port) are directly passed to the"
- echo " Tezos node, see '$0 shell tezos-node config --help'"
- echo " for more details."
- echo " By default, the RPC port is not exported outside the docker"
- echo " container. WARNING: when exported some RPCs could be harmful"
- echo " (e.g. 'inject_block', 'force_validation', ...), it is"
- echo " advised not to export them publicly."
- echo " $0 "
- echo " Friendly or brutally stop the node."
- echo " $0 restart"
- echo " Friendly stop the node, fetch the latest docker image and "
- echo " update this script, then start the node again."
- echo " The blockchain data are preserved."
- echo " $0 clear"
- echo " Remove all the blockchain data from the disk (except"
- echo " for secret keys and other configuration backup)."
- echo " $0 status"
- echo " Check that the running node is running and up to date."
- echo " Upgrade is automatically done by the start command."
- echo " $0 head"
- echo " Display info about the current head of the blockchain."
- echo " $0 client "
- echo " Pass a command to the tezos client."
- echo " $0 update_script"
- echo " Replace 'alphanet.sh' with the one found in the docker image."
- echo " Advanced commands:"
- echo " $0 node "
- echo " $0 baker "
- echo " $0 endorser "
- echo " $0 shell"
- echo "Node configuration backup directory: $data_dir"
- echo "Global options are currently limited to:"
- echo " --port "
- echo " change public the port Tezos node"
- echo "Container prefix:"
- echo " container:"
- echo " can be used anywhere 'file:' is permitted in client commands."
- echo " It will cause the referenced file to be copied into the docker conainer."
- echo " Files will be renamed, which may make errors difficult to read"
-}
-
-## Dispatch ################################################################
-
-if [ "$#" -ge 2 ] && [ "$1" = "--port" ] ; then
- port="$2"
- suffix="$port"
- shift 2
-fi
-
-command="$1"
-if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi
-
-case $(basename "$0") in
- localnet.sh)
- docker_base_dir="$HOME/.tezos-localnet"
- docker_image=tezos:latest
- docker_compose_base_name=localnet
- default_port=14732
- ;;
- zeronet.sh)
- docker_base_dir="$HOME/.tezos-zeronet"
- docker_image=tezos/tezos:zeronet
- docker_compose_base_name=zeronet
- default_port=19732
- ;;
- betanet.sh)
- if [ -d "$HOME/.tezos-mainnet" ] ; then
- echo 'You already upgraded, please only use `mainnet.sh` now.'
- exit 1
- else
- echo 'A new script `mainnet.sh` is now available.'
- echo 'The current `betanet.sh` still works, but we recommend that you upgrade.'
- fi
- docker_base_dir="$HOME/.tezos-betanet"
- docker_image=tezos/tezos:mainnet
- docker_compose_base_name=betanet
- default_port=9732
- ;;
- mainnet.sh)
- if [ -d "$HOME/.tezos-betanet" ] ; then
- echo 'Folder "'$HOME'/.tezos-betanet" detected.'
- echo 'To upgrade to the mainnet script, execute the following commands.'
- echo ' `betanet.sh stop`'
- echo 'Make sure that your node is stopped using `docker ps`.'
- echo ' `mv "'$HOME'/.tezos-betanet" "'$HOME'/.tezos-mainnet"`'
- echo ' `mainnet.sh start`'
- exit 1
- fi
- docker_base_dir="$HOME/.tezos-mainnet"
- docker_image=tezos/tezos:mainnet
- docker_compose_base_name=mainnet
- default_port=9732
- ;;
- *)
- docker_base_dir="$HOME/.tezos-alphanet"
- docker_image=tezos/tezos:alphanet
- docker_compose_base_name="alphanet"
- default_port=9732
- ;;
-esac
-
-if [ -n "$suffix" ] ; then
- mkdir -p "$docker_base_dir"
- echo "$port" > "$docker_base_dir/default_port"
-elif [ -f "$docker_base_dir/default_port" ]; then
- port=$(cat "$docker_base_dir/default_port")
- suffix="$port"
-else
- port=$default_port
-fi
-
-docker_dir="$docker_base_dir$suffix"
-docker_compose_yml="$docker_dir/docker-compose.yml"
-docker_pull_timestamp="$docker_dir/docker_pull.timestamp"
-active_protocol_versions="$docker_dir/active_protocol_versions"
-docker_compose_name="$docker_compose_base_name$suffix"
-
-docker_node_container=${docker_compose_name}_node_1
-
-docker_node_volume=${docker_compose_name}_node_data
-docker_client_volume=${docker_compose_name}_client_data
-
-mkdir -p "$docker_dir"
-
-case "$command" in
-
- ## Main
-
- start)
- start "$@"
- ;;
- restart)
- stop
- update_script
- export TEZOS_ALPHANET_DO_NOT_PULL=yes
- exec "$0" start "$@"
- ;;
- clear)
- clear_node_volume
- ;;
- status)
- status
- ;;
- stop)
- stop
- ;;
- kill)
- kill_
- ;;
-
- ## Node
-
- node)
- subcommand="$1"
- if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi
- case "$subcommand" in
- start)
- start_node "$@"
- ;;
- status)
- status_node
- ;;
- log)
- log_node
- ;;
- stop)
- stop_node
- ;;
- *)
- usage
- exit 1
- esac ;;
- ## Baker
-
- baker)
- subcommand="$1"
- if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi
- case "$subcommand" in
- status)
- status_baker
- ;;
- start)
- start_baker
- ;;
- log)
- log_baker
- ;;
- stop)
- stop_baker
- ;;
- *)
- usage
- exit 1
- esac ;;
-
- ## Endorser
-
- endorser)
- subcommand="$1"
- if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi
- case "$subcommand" in
- status)
- status_endorser
- ;;
- start)
- start_endorser
- ;;
- log)
- log_endorser
- ;;
- stop)
- stop_endorser
- ;;
- *)
- usage
- exit 1
- esac ;;
-
- ## Accuser
-
- accuser)
- subcommand="$1"
- if [ "$#" -eq 0 ] ; then usage ; exit 1; else shift ; fi
- case "$subcommand" in
- status)
- status_accuser
- ;;
- start)
- start_accuser
- ;;
- log)
- log_accuser
- ;;
- stop)
- stop_accuser
- ;;
- *)
- usage
- exit 1
- esac ;;
-
- ## Misc.
-
- head)
- display_head
- ;;
- shell)
- run_shell "$@"
- ;;
- client)
- run_client "$@"
- ;;
- admin-client)
- run_admin_client "$@"
- ;;
- check_script)
- warn_script_uptodate verbose
- ;;
- update_script)
- update_script
- ;;
- *)
- usage
- exit 1
- ;;
-esac
diff --git a/vendors/tezos-modded/scripts/alphanet_constants.patch b/vendors/tezos-modded/scripts/alphanet_constants.patch
deleted file mode 100644
index a5b662c3e..000000000
--- a/vendors/tezos-modded/scripts/alphanet_constants.patch
+++ /dev/null
@@ -1,20 +0,0 @@
-diff --git a/src/proto_alpha/lib_protocol/src/constants_repr.ml b/src/proto_alpha/lib_protocol/src/constants_repr.ml
-index 8ccaaee8..d17c4ada 100644
---- a/src/proto_alpha/lib_protocol/src/constants_repr.ml
-+++ b/src/proto_alpha/lib_protocol/src/constants_repr.ml
-@@ -68,12 +68,12 @@ let read_public_key s = Ed25519.Public_key.of_hex_exn (`Hex s)
-
- let default = {
- preserved_cycles = 5 ;
-- blocks_per_cycle = 4096l ;
-+ blocks_per_cycle = 128l ;
- blocks_per_commitment = 32l ;
-- blocks_per_roll_snapshot = 256l ;
-+ blocks_per_roll_snapshot = 8l ;
- blocks_per_voting_period = 32768l ;
- time_between_blocks =
-- List.map Period_repr.of_seconds_exn [ 60L ] ;
-+ List.map Period_repr.of_seconds_exn [ 60L ; 30L ; 20L ; 10L ] ;
- first_free_baking_slot = 16 ;
- endorsers_per_block = 32 ;
- max_gas = 40_000 ;
diff --git a/vendors/tezos-modded/scripts/alphanet_version b/vendors/tezos-modded/scripts/alphanet_version
deleted file mode 100644
index de461c2e1..000000000
--- a/vendors/tezos-modded/scripts/alphanet_version
+++ /dev/null
@@ -1 +0,0 @@
-2018-06-30T16:07:32Z
diff --git a/vendors/tezos-modded/scripts/apply_patch.sh b/vendors/tezos-modded/scripts/apply_patch.sh
deleted file mode 100755
index 437fc4957..000000000
--- a/vendors/tezos-modded/scripts/apply_patch.sh
+++ /dev/null
@@ -1,35 +0,0 @@
-#! /bin/sh
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-cd "$script_dir"/..
-
-branch=$1
-has_git() {
- which git && [ -d .git ]
-}
-
-if has_git && ! [ -z "$(git status -s)" ] ; then
- echo "This script cannot be applied within a dirty git directory,"
- echo "you need 'stash' or 'commit' your changes before."
- exit 1
-fi
-
-set -e
-
-case "$branch" in
- zeronet)
- sed -i s/TEZOS/TEZOS_ZERONET/ ./src/lib_shell/distributed_db_message.ml
- patch -p1 < scripts/alphanet_constants.patch
- patch -p1 < scripts/zeronet.patch
- if has_git; then git commit -a -m "Zeronet: change economic constants." --author "Tezos CI "; fi
- echo "Done"
- ;;
- alphanet)
- sed -i s/TEZOS/TEZOS_ALPHANET/ ./src/lib_shell/distributed_db_message.ml
- patch -p1 < scripts/alphanet_constants.patch
- if has_git; then git commit -a -m "Alphanet: change economic constants." --author "Tezos CI "; fi
- echo "Done"
- ;;
- *)
- echo "Noop"
-esac
diff --git a/vendors/tezos-modded/scripts/b58_prefix.py b/vendors/tezos-modded/scripts/b58_prefix.py
deleted file mode 100755
index 39870e986..000000000
--- a/vendors/tezos-modded/scripts/b58_prefix.py
+++ /dev/null
@@ -1,44 +0,0 @@
-#! /usr/bin/env python
-
-import sys
-import bitcoin
-
-alphabet = '123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz'
-
-
-def b58dec(word):
- x = 0
- for c in word:
- x *= 58
- x += alphabet.find(c)
- return x
-
-def asciidec(val):
- word = []
- while val > 0:
- word.append(val % 256)
- val /= 256
- return word[-1::-1]
-
-if __name__ == '__main__':
-
- prefix = sys.argv[1]
- length = int(sys.argv[2])
- target = b58dec(prefix)
-
- shift = 8*(length+4)
-
- for m in range(1,1000):
- lo = target * 58**m
- lo = (lo >> shift) + (0 if lo == ((lo >> shift) << shift) else 1)
- hi = (target + 1) * 58**m - (1 << shift) +1
- hi = hi >> shift
- if hi >= lo:
- # test
- for bt in '\x00\xff':
- s = bitcoin.bin_to_b58check(bt * length, magicbyte=lo)
- assert s.startswith(prefix)
- assert len(s) == m + len(prefix)
-
- print m + len(prefix), lo, asciidec(lo)
- exit(0)
diff --git a/vendors/tezos-modded/scripts/betanet.sh b/vendors/tezos-modded/scripts/betanet.sh
deleted file mode 120000
index 34a626507..000000000
--- a/vendors/tezos-modded/scripts/betanet.sh
+++ /dev/null
@@ -1 +0,0 @@
-alphanet.sh
\ No newline at end of file
diff --git a/vendors/tezos-modded/scripts/check_opam_test.sh b/vendors/tezos-modded/scripts/check_opam_test.sh
deleted file mode 100755
index d4540c3eb..000000000
--- a/vendors/tezos-modded/scripts/check_opam_test.sh
+++ /dev/null
@@ -1,36 +0,0 @@
-#! /bin/sh
-
-set -e
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-opams=$(find "$src_dir/vendors" "$src_dir/src" -name \*.opam -print)
-
-yml="${1:-$src_dir/.gitlab-ci.yml}"
-
-missing=
-for opam in $opams; do
- file=$(basename $opam)
- package=${file%.opam}
- if ! grep -qe "opam:..:$package:\$" "$yml"; then
- missing=yes
- echo "Missing test for package '$package'."
- fi
-done
-
-tested=$(grep -e '^opam:..:tezos-.*:$' "$yml" | cut -d: -f3)
-for package in $tested; do
- found=$(find "$src_dir/src" "$src_dir/vendors" -name $package.opam | wc -l 2>&1)
- if [ $found != 1 ] ; then
- missing=yes
- echo "Test for unknown package '$package'."
- fi
-done
-
-if ! [ -z "$missing" ]; then
- echo
- echo "You should update .gitlab-ci.yml by running: ./scripts/update_opam_test.sh"
- echo
- exit 1
-fi
diff --git a/vendors/tezos-modded/scripts/check_patch.sh b/vendors/tezos-modded/scripts/check_patch.sh
deleted file mode 100755
index c8ca53209..000000000
--- a/vendors/tezos-modded/scripts/check_patch.sh
+++ /dev/null
@@ -1,22 +0,0 @@
-#! /bin/sh
-
-set -e
-
-if [ $1 != "zeronet" ] && [ $1 != "alphanet" ] ; then
- echo Ignored
- exit 0
-fi
-
-if git log | grep "net: change economic constants" >/dev/null 2>&1 ; then
- echo OK
- exit 0
-fi
-
-cat < "$tmp_dir"/Dockerfile
-FROM $base_image
-COPY --chown=tezos:nogroup tezos tezos
-RUN opam exec -- make -C tezos all build-test
-EOF
-
-echo
-echo "### Building tezos..."
-echo
-
-docker build -t "$image_name:$image_version" "$tmp_dir"
-
-echo
-echo "### Successfully build docker image: $image_name:$image_version"
-echo
diff --git a/vendors/tezos-modded/scripts/ci/create_docker_image.minimal.sh b/vendors/tezos-modded/scripts/ci/create_docker_image.minimal.sh
deleted file mode 100755
index 652a782da..000000000
--- a/vendors/tezos-modded/scripts/ci/create_docker_image.minimal.sh
+++ /dev/null
@@ -1,65 +0,0 @@
-#! /bin/sh
-
-set -e
-
-ci_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-script_dir="$(dirname "$ci_dir")"
-src_dir="$(dirname "$script_dir")"
-cd "$src_dir"
-
-. "$script_dir"/version.sh
-
-tmp_dir=$(mktemp -dt tezos.opam.tezos.XXXXXXXX)
-
-image_name="${1:-tezos}"
-image_version="${2:-latest}"
-build_image="${3:-registry.gitlab.com/tezos/opam-repository:${opam_repository_tag}}"
-base_image="${4-registry.gitlab.com/tezos/opam-repository:minimal--${opam_repository_tag}}"
-
-cleanup () {
- set +e
- echo Cleaning up...
- rm -rf "$tmp_dir"
- if ! [ -z "$container" ]; then docker rm $container; fi
-}
-trap cleanup EXIT INT
-
-mkdir -p "$tmp_dir"/bin
-mkdir -p "$tmp_dir"/scripts
-container=$(docker create $build_image)
-versioned_daemons="$(sed "s/^\(.*\)$/tezos-baker-\1 tezos-endorser-\1 tezos-accuser-\1/g" "active_protocol_versions")"
-for bin in tezos-client tezos-admin-client tezos-node $versioned_daemons tezos-signer; do
- docker cp -L $container:/home/tezos/tezos/$bin "$tmp_dir"/bin
-done
-cp -a "$script_dir"/docker/entrypoint.sh "$tmp_dir"/bin/
-cp -a "$script_dir"/docker/entrypoint.inc.sh "$tmp_dir"/bin/
-cp "$script_dir"/alphanet.sh "$tmp_dir"/scripts/
-cp "$script_dir"/alphanet_version "$tmp_dir"/scripts/
-cp "$src_dir"/src/bin_client/bash-completion.sh "$tmp_dir"/scripts/
-cp "$src_dir"/active_protocol_versions "$tmp_dir"/scripts/
-
-echo
-echo "### Building minimal docker image..."
-echo
-
-cat > "$tmp_dir"/Dockerfile <= 2000:
- return 0
- return 6000 - (level/400)*250
- from_bitcoin = sum(x[u'satoshis'] * discount_level(x[u'crowdfund_level']) for x in w[u'utxos'])
- return from_ether + from_bitcoin * 1e-8
-
-def get_wallets(path):
- wallets = {}
- for fn in os.listdir(path):
- # ignore misc files
- if not fn.startswith("tz1"):
- continue
- w = json.load(open(os.path.join(path, fn), "r"))
- # if not u'allocated_tezzies' in w.keys():
- # continue
- wallets[fn.split(".")[0]] = allocate_with_subthreshold(w)
- return wallets
-
-def secret_code(pkh, blind):
- return blake2b(pkh, 20, key=blind).digest()
-
-def genesis_commitments(wallets, blind):
- commitments = []
- for pkh_b58, amount in wallets.iteritems():
- # Public key hash corresponding to this Tezos address.
- pkh = bitcoin.b58check_to_bin(pkh_b58)[2:]
- # The redemption code is unique to the public key hash and deterministically
- # constructed using a secret blinding value.
- secret = secret_code(pkh, blind)
- # The redemption code is used to blind the pkh
- blinded_pkh = blake2b(pkh, 20, key=secret).digest()
- commitment = {
- 'blinded_pkh': bitcoin.bin_to_b58check(blinded_pkh, magicbyte=16921055),
- 'amount': amount
- }
- commitments.append(commitment)
- return commitments
-
-# Generate dummy genesis information for a centralized alphanet faucet
-def make_dummy_wallets(n, blind):
- # Not a realistic shape, but for an alphanet faucet it's better to
- # have less variance.
- amounts = np.random.pareto(10.0, n)
- amounts = amounts / sum(amounts) * 700e6
- wallets = {}
- secrets = {}
- for i in range(0, n):
- entropy = blake2b(str(i), 20, key=blind).digest()
- mnemonic = bitcoin.mnemonic.entropy_to_words(entropy)
- password = ''.join(random.choice(string.letters + string.digits) for _ in range(10))
- email = random_email()
- sk, pk, pkh, pkh_b58 = get_keys(' '.join(mnemonic), email, password)
- amount = tez_to_int(amounts[i])
- wallets[pkh_b58] = amount
- secret = secret_code(pkh, blind)
- secrets[pkh_b58] = (mnemonic, email, password, amount, binascii.hexlify(secret))
- return wallets, secrets
-
-if __name__ == '__main__':
- if len(sys.argv) < 3:
- print "Usage: python create_genesis_info.py /path/to/json blind [dummy]"
- exit(1)
- blind = sys.argv[2]
- if len(sys.argv) == 4 and sys.argv[3] == "dummy":
- wallets, secrets = make_dummy_wallets(30000, blind)
- with open('secret_seeds.json', 'w') as f:
- json.dump([ { "pkh" : pkh,
- "mnemonic" : mnemonic,
- "email" : email,
- "password" : password,
- "amount" : str(amount),
- "activation_code" : secret }
- for pkh, (mnemonic, email, password, amount, secret) in secrets.iteritems()], f, indent=1)
- else:
- wallets = get_wallets( sys.argv[1] )
-
- commitments = genesis_commitments(wallets, blind)
-
- with open('commitments.json', 'w') as f:
- json.dump({
- "bootstrap_accounts": [
- [ "edsk4X12XaKRPHgDkgvMe4UWEiygx8AVrt9rpktmhu1uT2GCPU4dp7",
- "12000000000000" ],
- [ "edsk46ypB8PztxMDPMdVnEgjQmJhca7zMJvTMDrdwJaJ4mgm4qNmwE",
- "12000000000000" ],
- [ "edsk4JsBpWJH5cDtanNADY2D5Ygma1dUtxko8qaM2Af8FHGU52yLcW",
- "12000000000000" ],
- [ "edsk3b5GrQdRF1Pt3ccRjvyoNHTFrSXUKZufg2zQYhBumqS8kMfeGC",
- "12000000000000" ],
- [ "edsk3T8CRr8YK2vnjsZK2vDzCjpcWpMEUXMAzjeR1GWjmyhGaDHTNV",
- "12000000000000" ]
- ],
- "commitments": [
- (commitment['blinded_pkh'], str(commitment['amount']))
- for commitment in commitments if commitment['amount'] > 0
- ],
- "no_rewards_cycles": 7,
- "security_deposit_ramp_up_cycles": 64
- }, f, indent=1)
diff --git a/vendors/tezos-modded/scripts/create_genesis/requirements.txt b/vendors/tezos-modded/scripts/create_genesis/requirements.txt
deleted file mode 100644
index d3da7afb8..000000000
--- a/vendors/tezos-modded/scripts/create_genesis/requirements.txt
+++ /dev/null
@@ -1,3 +0,0 @@
--e git+https://github.com/vbuterin/pybitcointools.git@aeb0a2bbb8bbfe421432d776c649650eaeb882a5#egg=master
-pyblake2==0.9.3
-pysodium==0.6.11
diff --git a/vendors/tezos-modded/scripts/docker/docker-compose-generic.yml b/vendors/tezos-modded/scripts/docker/docker-compose-generic.yml
deleted file mode 100644
index 32d09755a..000000000
--- a/vendors/tezos-modded/scripts/docker/docker-compose-generic.yml
+++ /dev/null
@@ -1,57 +0,0 @@
-version: "2"
-services:
-
- node:
- image: tezos/tezos:latest
- hostname: node
- command: tezos-node
- ports:
- - 9732:9732
- expose:
- - '8732'
- volumes:
- - node_data:/var/run/tezos/node
- - client_data:/var/run/tezos/client
- restart: on-failure
-
- ## Duplicate the `baker/endorser/accuser` containers for each PROTOCOL
- ## in file `active_protocol_versions`
- baker-alpha:
- image: tezos/tezos:latest
- hostname: baker-alpha
- environment:
- - PROTOCOL=alpha
- command: tezos-baker
- links:
- - node
- volumes:
- - client_data:/var/run/tezos/client
- restart: on-failure
-
- endorser-alpha:
- image: tezos/tezos:latest
- hostname: endorser-alpha
- environment:
- - PROTOCOL=alpha
- command: tezos-endorser
- links:
- - node
- volumes:
- - client_data:/var/run/tezos/client
- restart: on-failure
-
- accuser-alpha:
- image: tezos/tezos:latest
- hostname: accuser-alpha
- environment:
- - PROTOCOL=alpha
- command: tezos-accuser
- links:
- - node
- volumes:
- - client_data:/var/run/tezos/client
- restart: on-failure
-
-volumes:
- node_data:
- client_data:
diff --git a/vendors/tezos-modded/scripts/docker/entrypoint.inc.sh b/vendors/tezos-modded/scripts/docker/entrypoint.inc.sh
deleted file mode 100644
index 92fdb7c87..000000000
--- a/vendors/tezos-modded/scripts/docker/entrypoint.inc.sh
+++ /dev/null
@@ -1,134 +0,0 @@
-#!/bin/sh
-
-configure_client() {
-
- local client_config="$HOME/.tezos-client/config"
- mkdir -p "$client_dir" "$HOME/.tezos-client"
-
- if [ ! -f "$client_config" ]; then
- "$client" --base-dir "$client_dir" \
- --addr "$NODE_HOST" --port "$NODE_RPC_PORT" \
- config init --output "$client_config" >/dev/null 2>&1
- else
- "$client" --base-dir "$client_dir" \
- --addr "$NODE_HOST" --port "$NODE_RPC_PORT" \
- config update >/dev/null 2>&1
- fi
-
-}
-
-wait_for_the_node_to_be_ready() {
- local count=0
- if "$client" rpc get /chains/main/blocks/head/hash >/dev/null 2>&1; then return; fi
- printf "Waiting for the node to initialize..."
- sleep 1
- while ! "$client" rpc get /chains/main/blocks/head/hash >/dev/null 2>&1
- do
- count=$((count+1))
- if [ "$count" -ge 30 ]; then
- echo " timeout."
- exit 2
- fi
- printf "."
- sleep 1
- done
- echo " done."
-}
-
-wait_for_the_node_to_be_bootstraped() {
- wait_for_the_node_to_be_ready
- echo "Waiting for the node to synchronize with the network..."
- "$client" bootstrapped
-}
-
-launch_node() {
-
- mkdir -p "$node_dir"
-
- # Check if we have to reset the chain because the image we want to
- # run has a incompatible version with the blockchain we have stored
- # locally on disk
-
- local image_version="$(cat "/usr/local/share/tezos/alphanet_version")"
- echo "Current public chain: $image_version."
- local local_data_version=""
- if [ -f "$node_dir/alphanet_version" ]; then
- local_data_version="$(cat "$node_dir/alphanet_version")"
- echo "Local chain data: $local_data_version."
- fi
- if [ "$local_data_version" != "$image_version" ]; then
- echo "Removing outdated chain data..."
- if [ -f "$node_data_dir/identity.json" ]; then \
- mv "$node_data_dir/identity.json" /tmp
- fi
- rm -rf "$node_data_dir"
- rm -rf "$client_dir/blocks"
- rm -rf "$client_dir/nonces"
- rm -rf "$client_dir/endorsements"
- if [ -f "/tmp/identity.json" ]; then \
- mkdir -p "$node_data_dir"
- mv /tmp/identity.json "$node_data_dir/"
- fi
- cp "/usr/local/share/tezos/alphanet_version" \
- "$node_dir/alphanet_version"
- fi
-
- mkdir -p "$node_data_dir"
-
- if [ ! -f "$node_data_dir/config.json" ]; then
- echo "Configuring the node..."
- "$node" config init \
- --data-dir "$node_data_dir" \
- --rpc-addr ":$NODE_RPC_PORT" \
- "$@"
- else
- echo "Updating the node configuration..."
- "$node" config update \
- --data-dir "$node_data_dir" \
- --rpc-addr ":$NODE_RPC_PORT" \
- "$@"
- fi
-
- for i in "$@"; do
- if [ "$i" = "--help" ] ; then exit 0; fi
- done
-
- # Generate a new identity if not present
-
- if [ ! -f "$node_data_dir/identity.json" ]; then
- echo "Generating a new node identity..."
- "$node" identity generate "${IDENTITY_POW:-26}". \
- --data-dir "$node_data_dir"
- fi
-
- configure_client
-
- # Launching the node
-
- exec "$node" run --data-dir "$node_data_dir"
-
-}
-
-launch_baker() {
- configure_client
- wait_for_the_node_to_be_bootstraped
- exec "$baker" --base-dir "$client_dir" \
- --addr "$NODE_HOST" --port "$NODE_RPC_PORT" \
- run with local node "$node_data_dir" "$@"
-}
-
-launch_endorser() {
- configure_client
- wait_for_the_node_to_be_bootstraped
- exec "$endorser" --base-dir "$client_dir" \
- --addr "$NODE_HOST" --port "$NODE_RPC_PORT" \
- run "$@"
-}
-
-launch_accuser() {
- configure_client
- wait_for_the_node_to_be_bootstraped
- exec "$accuser" --base-dir "$client_dir" \
- --addr "$NODE_HOST" --port "$NODE_RPC_PORT" \
- run "$@"
-}
diff --git a/vendors/tezos-modded/scripts/docker/entrypoint.sh b/vendors/tezos-modded/scripts/docker/entrypoint.sh
deleted file mode 100755
index e19f828e7..000000000
--- a/vendors/tezos-modded/scripts/docker/entrypoint.sh
+++ /dev/null
@@ -1,66 +0,0 @@
-#!/bin/sh
-
-set -e
-
-bin_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-
-: ${BIN_DIR:="/usr/local/bin"}
-: ${DATA_DIR:="/var/run/tezos"}
-
-: ${NODE_HOST:="node"}
-: ${NODE_RPC_PORT:="8732"}
-
-: ${PROTOCOL:="unspecified-PROTOCOL-variable"}
-
-node="$BIN_DIR/tezos-node"
-client="$BIN_DIR/tezos-client"
-admin_client="$BIN_DIR/tezos-admin-client"
-baker="$BIN_DIR/tezos-baker-$PROTOCOL"
-endorser="$BIN_DIR/tezos-endorser-$PROTOCOL"
-accuser="$BIN_DIR/tezos-accuser-$PROTOCOL"
-signer="$BIN_DIR/tezos-signer"
-
-client_dir="$DATA_DIR/client"
-node_dir="$DATA_DIR/node"
-node_data_dir="$node_dir/data"
-
-. "$bin_dir/entrypoint.inc.sh"
-
-command=${1:-tezos-node}
-shift 1
-
-case $command in
- tezos-node)
- launch_node "$@"
- ;;
- tezos-baker)
- launch_baker "$@"
- ;;
- tezos-endorser)
- launch_endorser "$@"
- ;;
- tezos-accuser)
- launch_accuser "$@"
- ;;
- tezos-client)
- configure_client
- exec "$client" "$@"
- ;;
- tezos-admin-client)
- configure_client
- exec "$admin_client" "$@"
- ;;
- tezos-signer)
- exec "$signer" "$@"
- ;;
- *)
- cat < genesis ()
- | Some p ->
- let p = String.sub p 0 (String.length p - 4) in
- Base58.safe_encode p, date
-
-let genesis, date = genesis ()
-
-let () =
- Lwt_main.run @@
- let stream = Lwt_io.lines_of_file "alphanet_version" in
- Lwt_stream.to_list stream >>= function
- | [] | _ :: _ :: _ -> failwith "bad alphanet_version file"
- | [ line ] -> match String.split_on_char 'Z' line with
- | [ _ ; branch ] ->
- let contents = if String.trim branch = "" then date else date ^ branch in
- Lwt_io.lines_to_file "alphanet_version" (Lwt_stream.of_list [ contents ])
- | _ -> failwith "bad alphanet_version file"
-
-let sed =
- Format.sprintf
- "sed -i.old \
- -e 's/Time.of_notation_exn \"[^\\\"]*\"/Time.of_notation_exn \"%s\"/' \
- -e 's/BLockGenesisGenesisGenesisGenesisGenesis.........../%s/' \
- ../src/bin_node/node_run_command.ml"
- date
- genesis
-
-let () =
- Lwt_main.run (Lwt_process.exec (Lwt_process.shell sed) >>= fun _ ->
- Lwt_unix.unlink "../src/bin_node/node_run_command.ml.old")
-
-let sed =
- Format.sprintf
- "sed -E -i.old \
- -e 's/name = \"(TEZOS[_A-Z]+)[^\"]*\" ;/name = \"\\1%s\" ;/' \
- ../src/lib_shell/distributed_db_message.ml"
- date
-
-let () =
- Lwt_main.run (Lwt_process.exec (Lwt_process.shell sed) >>= fun _ ->
- Lwt_unix.unlink "../src/lib_shell/distributed_db_message.ml.old")
diff --git a/vendors/tezos-modded/scripts/install_build_deps.raw.sh b/vendors/tezos-modded/scripts/install_build_deps.raw.sh
deleted file mode 100755
index 79e443b61..000000000
--- a/vendors/tezos-modded/scripts/install_build_deps.raw.sh
+++ /dev/null
@@ -1,16 +0,0 @@
-#! /bin/sh
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-. "$script_dir"/version.sh
-
-opams=$(find "$src_dir/vendors" "$src_dir/src" -name \*.opam -print)
-
-export OPAMYES=${OPAMYES:=true}
-
-## In an ideal world, `--with-test` should be present only when using
-## `--dev`. But this would probably break the CI, so we postponed this
-## change until someone have some spare time. (@pirbo, @hnrgrgr)
-
-opam install $opams --deps-only --with-test --criteria="-notuptodate,-changed,-removed"
diff --git a/vendors/tezos-modded/scripts/install_build_deps.sh b/vendors/tezos-modded/scripts/install_build_deps.sh
deleted file mode 100755
index e4803c887..000000000
--- a/vendors/tezos-modded/scripts/install_build_deps.sh
+++ /dev/null
@@ -1,45 +0,0 @@
-#! /bin/sh
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-. "$script_dir"/version.sh
-
-if [ "$1" = "--dev" ]; then
- dev=yes
-else
- dev=
-fi
-
-opam repository set-url tezos --dont-select $opam_repository || \
- opam repository add tezos --dont-select $opam_repository > /dev/null 2>&1
-
-opam update --repositories --development
-
-if [ ! -d "$src_dir/_opam" ] ; then
- opam switch create "$src_dir" --repositories=tezos ocaml-base-compiler.$ocaml_version
-fi
-
-if [ ! -d "$src_dir/_opam" ] ; then
- echo "Failed to create the opam switch"
- exit 1
-fi
-
-eval $(opam env --shell=sh)
-
-if [ -n "$dev" ]; then
- opam repository remove default > /dev/null 2>&1 || true
-fi
-
-if [ "$(ocaml -vnum)" != "$ocaml_version" ]; then
- opam install --unlock-base ocaml-base-compiler.$ocaml_version
-fi
-
-opam list --installed opam-depext || opam --yes install opam-depext
-
-"$script_dir"/install_build_deps.raw.sh
-
-if [ -n "$dev" ]; then
- opam repository add default --rank=-1 > /dev/null 2>&1 || true
- opam install merlin
-fi
diff --git a/vendors/tezos-modded/scripts/localnet.sh b/vendors/tezos-modded/scripts/localnet.sh
deleted file mode 120000
index 34a626507..000000000
--- a/vendors/tezos-modded/scripts/localnet.sh
+++ /dev/null
@@ -1 +0,0 @@
-alphanet.sh
\ No newline at end of file
diff --git a/vendors/tezos-modded/scripts/mainnet.sh b/vendors/tezos-modded/scripts/mainnet.sh
deleted file mode 120000
index 34a626507..000000000
--- a/vendors/tezos-modded/scripts/mainnet.sh
+++ /dev/null
@@ -1 +0,0 @@
-alphanet.sh
\ No newline at end of file
diff --git a/vendors/tezos-modded/scripts/nginx.conf b/vendors/tezos-modded/scripts/nginx.conf
deleted file mode 100644
index 2db9fae21..000000000
--- a/vendors/tezos-modded/scripts/nginx.conf
+++ /dev/null
@@ -1,31 +0,0 @@
-# /etc/nginx/nginx.conf
-
-user nginx;
-
-worker_processes 1;
-error_log off;
-
-events {
- worker_connections 1024;
-}
-
-http {
- server_tokens off;
- client_max_body_size 0;
- keepalive_timeout 65;
- tcp_nodelay on;
- access_log off;
- server {
- listen 80 default_server;
- listen [::]:80 default_server;
- location / {
- proxy_pass http://127.0.0.1:8732/;
- }
- location ~ ^/(validate_block|network/connection/.*/kick|network/connect/|(forge|inject)_(block|operation|protocol)/) {
- return 404;
- }
- location = /404.html {
- internal;
- }
- }
-}
diff --git a/vendors/tezos-modded/scripts/ocamldot.py b/vendors/tezos-modded/scripts/ocamldot.py
deleted file mode 100755
index 1f44d0f0e..000000000
--- a/vendors/tezos-modded/scripts/ocamldot.py
+++ /dev/null
@@ -1,85 +0,0 @@
-#!/usr/bin/python
-
-import re
-import sys
-import os
-import argparse
-from sets import Set
-
-alldeps={}
-allmodules={}
-
-def sanitize(s):
- s=re.sub('.*/','',s)
- s=re.sub('[^0-9a-zA-Z]+', '_', s)
- return s
-
-def cleanName(s):
- ml = os.path.basename(s)
- (mod,_) = os.path.splitext(ml)
- return mod.capitalize()
-
-def mangle(f,modulename):
-
- dictionary = {}
- for line in open(f):
- s=line.split();
- for x in range(2, len(s)):
- mod = cleanName(s[0])
- dep = sanitize(s[x])
- if mod in dictionary :
- dictionary[mod].append(dep)
- else :
- dictionary[mod] = [dep]
- allmodules.update({mod : modulename})
-
- alldeps[modulename] = dictionary
-
-def cleanup(alldeps):
- # remove references to external libraries
- for (name,dictionary) in alldeps.iteritems() :
- for (mod,deps) in dictionary.iteritems() :
- dictionary[mod] = [x for x in deps if x in allmodules]
- alldeps[name] = dictionary
- return alldeps
-
-def print_graph(alldeps):
- print("strict digraph G {")
- print('graph [fontsize=10 fontname="Verdana"];')
- print('node [shape=record fontsize=10 fontname="Verdana" compound=true];')
- counter = 0
- l = { x: i for i,x in enumerate(alldeps.keys())}
- for (name,dictionary) in alldeps.iteritems() :
- names = ['"%s"' % mod for mod in dictionary.keys()]
- if len(names) > 0 :
- print ('subgraph cluster_%i { label = "%s"; color=blue; node [style=filled];' % (l[name],name))
- counter += 1
- for (mod,deps) in dictionary.iteritems() :
- for dep in deps :
- if dep in dictionary :
- print ('"%s" -> "%s";' % (mod,dep))
- print "}"
- # for (mod,deps) in dictionary.iteritems() :
- # for dep in deps :
- # if dep not in dictionary :
- # print ('"%s" -> "%s" [ltail=cluster_%i lhead=cluster_%i];' % (mod,dep,l[name],l[allmodules[dep]]))
- print "}"
-
-def scan(directories):
- ext = ".depends.ocamldep-output"
- for directory in directories:
- for root, dirs, files in os.walk(directory):
- for f in files:
- if f.endswith(ext):
- mangle(os.path.join(root, f),f[:-len(ext)])
- print_graph(cleanup(alldeps))
-
-def main():
- parser = argparse.ArgumentParser(description='OcamlDep Dependency Tree')
- parser.add_argument('inputdirs', type=str, nargs='*', help="directories to scan")
- args = parser.parse_args()
-
- scan(args.inputdirs)
-
-if __name__ == '__main__':
- main()
diff --git a/vendors/tezos-modded/scripts/opam-check.sh b/vendors/tezos-modded/scripts/opam-check.sh
deleted file mode 100755
index e83977faa..000000000
--- a/vendors/tezos-modded/scripts/opam-check.sh
+++ /dev/null
@@ -1,39 +0,0 @@
-#! /bin/sh
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-. "$script_dir"/version.sh
-
-opams=$(find "$src_dir/vendors" "$src_dir/src" -name \*.opam -print)
-
-echo "## Checking installed dependencies..."
-echo
-
-if ! opam install $opams --deps-only --with-test --show-actions | grep "Nothing to do." > /dev/null 2>&1 ; then
- echo
- echo 'Failure! Missing actions:'
- echo
- opam install $opams --deps-only --with-test --show-actions
- echo
- echo 'Failed! Please read the doc in `./scripts/update_opam_repo.sh` and act accordingly.'
- echo
- exit 1
-fi
-
-echo '## Running `./scripts/update_opam_repo.sh`'
-echo
-./scripts/update_opam_repo.sh
-
-if [ -n "$(cat opam_repo.patch)" ] ; then
-
- echo "##################################################"
- cat opam_repo.patch
- echo "##################################################"
-
- echo 'Failed! The variables `opam_repository_tag` and `full_opam_repository_tag` are not synchronized. Please read the doc in `./scripts/update_opam_repo.sh` and act accordingly.'
- echo
- exit 1
-fi
-
-echo "Ok."
diff --git a/vendors/tezos-modded/scripts/opam-pin.sh b/vendors/tezos-modded/scripts/opam-pin.sh
deleted file mode 100755
index ff4509f2f..000000000
--- a/vendors/tezos-modded/scripts/opam-pin.sh
+++ /dev/null
@@ -1,30 +0,0 @@
-#! /bin/sh
-
-set -e
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-export OPAMYES=yes
-
-echo
-echo "## Pinning tezos packages..."
-
-opams=$(find "$src_dir/vendors" "$src_dir/src" -name \*.opam -print)
-
-packages=
-for opam in $opams; do
- dir=$(dirname $opam)
- file=$(basename $opam)
- package=${file%.opam}
- packages="$packages $package"
- opam pin add --no-action $package $dir > /dev/null 2>&1
-done
-
-packages=$(opam list --short --sort --pinned $packages)
-
-echo
-echo "## Pinned packages:"
-echo
-echo "$packages" | sed 's/^/ /'
-echo
diff --git a/vendors/tezos-modded/scripts/opam-remove.sh b/vendors/tezos-modded/scripts/opam-remove.sh
deleted file mode 100755
index 0de2cd8f2..000000000
--- a/vendors/tezos-modded/scripts/opam-remove.sh
+++ /dev/null
@@ -1,20 +0,0 @@
-#! /bin/sh
-
-set -e
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-opams=$(find "$src_dir" -name \*.opam)
-packages=
-
-for opam in $opams; do
- dir=$(dirname $opam)
- file=$(basename $opam)
- package=${file%.opam}
- packages="$packages $package"
-done
-
-installed=$(opam list --short --installed --pinned $packages)
-
-opam remove $installed
diff --git a/vendors/tezos-modded/scripts/opam-test-all.sh b/vendors/tezos-modded/scripts/opam-test-all.sh
deleted file mode 100755
index 812db7b6a..000000000
--- a/vendors/tezos-modded/scripts/opam-test-all.sh
+++ /dev/null
@@ -1,74 +0,0 @@
-#! /bin/sh
-
-set -e
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-cd "$src_dir"
-
-cleanup () {
- set +e
- if [ -f LOG ]; then
- echo "failed."
- echo
- cat LOG
- rm LOG
- echo
- exit 1
- fi
-}
-trap cleanup EXIT INT
-
-silent () {
- "$@" > LOG 2>&1
- rm LOG
-}
-
-requested_packages="$@"
-
-export OPAMYES=yes
-
-echo -n "Cleanup state and pin packages..."
-silent ./scripts/opam-unpin.sh
-silent . ./scripts/opam-pin.sh
-echo " OK."
-
-if ! [ -z "$requested_packages" ]; then
- packages="$requested_packages"
-fi
-
-okfile="$0.DONE"
-touch $okfile
-ok=$(cat "$okfile")
-
-ignore() {
- for i in $ok; do
- if [ $i = $1 ]; then return 0; fi
- done
- return 1
-}
-
-for package in $packages; do
-
- if ignore $package; then
- echo "Ignoring: $package."
- continue
- fi
-
- echo -n "Installing: $package..."
- silent opam install $package
- echo " OK."
-
- echo -n "Removing: $package..."
- silent opam remove -a $package
- echo " OK."
-
- echo $package >> "$okfile"
-
-done
-
-echo
-echo "Successfully installed the following packages: "
-echo
-cat $okfile | sed 's/^/- /'
-rm $okfile
diff --git a/vendors/tezos-modded/scripts/opam-unpin.sh b/vendors/tezos-modded/scripts/opam-unpin.sh
deleted file mode 100755
index e22c0f72d..000000000
--- a/vendors/tezos-modded/scripts/opam-unpin.sh
+++ /dev/null
@@ -1,13 +0,0 @@
-#! /bin/sh
-
-set -e
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-. "$script_dir"/opam-remove.sh
-
-echo
-echo "## Unpinning tezos packages..."
-
-opam pin remove $packages > /dev/null 2>&1
diff --git a/vendors/tezos-modded/scripts/opam-upgrade.sh b/vendors/tezos-modded/scripts/opam-upgrade.sh
deleted file mode 100755
index 292214d74..000000000
--- a/vendors/tezos-modded/scripts/opam-upgrade.sh
+++ /dev/null
@@ -1,35 +0,0 @@
-#! /bin/sh
-
-set -e
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-cd "$src_dir"
-
-cleanup () {
- set +e
- if [ -f LOG ]; then
- echo "Failure"
- echo
- cat LOG
- echo
- exit 1
- fi
-}
-trap cleanup EXIT INT
-
-silent () {
- "$@" > LOG 2>&1
- rm LOG
-}
-
-echo "Updating package description..."
-silent . ./scripts/opam-pin.sh
-
-upgradables=$(opam list --short --installed --pinned $packages)
-
-if [ -z "$upgradables" ]; then
- echo "No previously installed package. Nothing to do."
- exit 1
-fi
-opam upgrade $upgradables
diff --git a/vendors/tezos-modded/scripts/protocol_parameters.json b/vendors/tezos-modded/scripts/protocol_parameters.json
deleted file mode 100644
index 92922ca2c..000000000
--- a/vendors/tezos-modded/scripts/protocol_parameters.json
+++ /dev/null
@@ -1,48 +0,0 @@
-{ "bootstrap_accounts": [
- [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav", "4000000000000" ],
- [ "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9", "4000000000000" ],
- [ "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV", "4000000000000" ],
- [ "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU", "4000000000000" ],
- [ "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n", "4000000000000" ],
- [ "tz1PooUKBaoxjBiCR2dxEtbtTUjLX3iaZQoJ", "100" ],
- [ "edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2", "1" ] ],
- "bootstrap_contracts": [
- { "delegate": "tz1TGu6TN5GSez2ndXXeDX6LgUDvLzPLqgYV",
- "amount": "10000000",
- "script":
- { "code":
- [ { "prim": "parameter",
- "args": [ { "prim": "key_hash" } ] },
- { "prim": "storage",
- "args": [ { "prim": "timestamp" } ] },
- { "prim": "code",
- "args":
- [ [ [ [ { "prim": "DUP" }, { "prim": "CAR" },
- { "prim": "DIP", "args": [ [ { "prim": "CDR" } ] ] } ] ],
- { "prim": "SWAP" },
- { "prim": "PUSH", "args": [ { "prim": "int" }, { "int": "300" } ] },
- { "prim": "ADD", "annots": [ "@FIVE_MINUTES_LATER" ] },
- { "prim": "NOW" },
- [ [ { "prim": "COMPARE" }, { "prim": "GE" } ],
- { "prim": "IF",
- "args":
- [ [],
- [ [ { "prim": "UNIT" },
- { "prim": "FAILWITH" } ] ] ] } ],
- { "prim": "IMPLICIT_ACCOUNT" },
- { "prim": "PUSH", "args": [ { "prim": "mutez" }, { "int": "1000000" } ] },
- { "prim": "UNIT" },
- { "prim": "TRANSFER_TOKENS" },
- { "prim": "NIL", "args": [ { "prim": "operation" } ] },
- { "prim": "SWAP" },
- { "prim": "CONS" },
- { "prim": "DIP", "args": [ [ { "prim": "NOW" } ] ] },
- { "prim": "PAIR" } ] ] } ],
- "storage": { "int": "0" } } } ],
- "time_between_blocks" : [ "1", "0" ],
- "blocks_per_roll_snapshot" : 4,
- "blocks_per_cycle" : 8,
- "blocks_per_voting_period" : 64,
- "preserved_cycles" : 2,
- "proof_of_work_threshold": "-1"
-}
diff --git a/vendors/tezos-modded/scripts/reset_chain.sh b/vendors/tezos-modded/scripts/reset_chain.sh
deleted file mode 100755
index dd815e874..000000000
--- a/vendors/tezos-modded/scripts/reset_chain.sh
+++ /dev/null
@@ -1,23 +0,0 @@
-#! /bin/sh
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-cd "$script_dir"/..
-
-branch=$1
-has_git() {
- which git && [ -d .git ]
-}
-
-if has_git && ! [ -z "$(git status -s)" ] ; then
- echo "This script cannot be applied within a dirty git directory,"
- echo "you need 'stash' or 'commit' your changes before."
- exit 1
-fi
-
-set -e
-
-cd scripts
-
-ocaml gen_genesis.ml
-
-git commit -a -m "Reset the chain"
diff --git a/vendors/tezos-modded/scripts/sandbox.json b/vendors/tezos-modded/scripts/sandbox.json
deleted file mode 100644
index 007ba123e..000000000
--- a/vendors/tezos-modded/scripts/sandbox.json
+++ /dev/null
@@ -1,4 +0,0 @@
-{
- "genesis_pubkey":
- "edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2"
-}
diff --git a/vendors/tezos-modded/scripts/snapshot_alpha.sh b/vendors/tezos-modded/scripts/snapshot_alpha.sh
deleted file mode 100755
index 99235cfd5..000000000
--- a/vendors/tezos-modded/scripts/snapshot_alpha.sh
+++ /dev/null
@@ -1,124 +0,0 @@
-#! /bin/bash
-
-set -e
-
-usage="Usage:
-$ ./scripts/snapshot_alpha.sh babylon_005 from athens_004
-Packs the current proto_alpha directory in a new proto_005_
-directory with all the necessary renamings.
-With option --master prepares the protocol for master."
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-cd "$script_dir"/..
-
-current=$1
-label=$(echo $current | cut -d'_' -f1)
-version=$(echo $current | cut -d'_' -f2)
-
-if ! ( [[ "$label" =~ ^[a-z]+$ ]] && [[ "$version" =~ ^[0-9][0-9][0-9]$ ]] ); then
- echo "Wrong protocol version"
- echo
- echo "$usage"
- exit 1
-fi
-
-predecessor=$3
-previous_label=$(echo $predecessor | cut -d'_' -f1)
-previous_version=$(echo $predecessor | cut -d'_' -f2)
-if ! ( [[ "$2" == "from" ]] && [[ "$3" ]] && [[ "$previous_label" =~ ^[a-z]+$ ]] && [[ "$previous_version" =~ ^[0-9][0-9][0-9]$ ]] ); then
- if [[ "$2" == "--master" ]]; then master="true"
- else
- echo 'pass a predecessor such as "from athens_004" or "--master"'
- echo
- echo "$usage"
- exit 1
- fi
-fi
-
-if [ -d src/proto_${version} ] ; then
- echo "Error: you should remove the directory 'src/proto_${version}'"
- exit 1
-fi
-
-#create a temporary directory until the hash is known
-cp -r src/proto_alpha/ src/proto_${version}
-
-# set current version
-sed -i --follow-symlink \
- -e 's/let version_value = "alpha_current"/let version_value = "'${current}'"/' \
- src/proto_${version}/lib_protocol/src/raw_context.ml
-
-# set previous version
-if [[ "$master" ]]; then
- #in master our predecessor is alpha_current
- sed -i --follow-symlink \
- -e 's/s = "alpha_previous"/s = "alpha_current"/' \
- src/proto_${version}/lib_protocol/src/raw_context.ml
-else
- # set previous version
- sed -i --follow-symlink \
- -e 's/Alpha_previous/'${predecessor^}'/' \
- src/proto_${version}/lib_protocol/src/{raw_context.ml,raw_context.mli,init_storage.ml}
-
- # set previous version
- sed -i --follow-symlink \
- -e 's/s = "alpha_previous"/s = "'${predecessor}'"/' \
- src/proto_${version}/lib_protocol/src/raw_context.ml
-fi
-
-long_hash=$(./tezos-protocol-compiler -hash-only src/proto_${version}/lib_protocol/src)
-short_hash=$(echo $long_hash | head -c 8)
-
-if [ -d src/proto_${version}_${short_hash} ] ; then
- echo "Error: you should remove the directory 'src/proto_${version}_${short_hash}'"
- exit 1
-fi
-
-mv src/proto_${version} src/proto_${version}_${short_hash}
-
-cd src/proto_${version}_${short_hash}
-
-# the following files do not influence the hash
-
-# replace fake hash with real hash
-sed -i --follow-symlink \
- -e 's/"hash": "[^"]*",/"hash": "'$long_hash'",/' \
- lib_protocol/src/TEZOS_PROTOCOL
-
-sed -i --follow-symlink \
- -e 's/"alpha"/"'${version}-${short_hash}'"/' \
- lib_client/proto_alpha.ml
-
-sed -i --follow-symlink \
- -e s/protocol_alpha/protocol_${version}_${short_hash}/ \
- $(find -name \*.ml -or -name \*.mli)
-
-# rename main_*.ml{,i} files of the binaries
-rename s/_alpha/_${version}_${short_hash}/ $(find -name main_\*.ml -or -name main_\*.mli)
-
-# change version in opam files
-sed -i --follow-symlink \
- -e 's/Some \\"alpha\\"/Some \\"'${version}_${short_hash}'\\"/' \
- lib_protocol/tezos{,-embedded}-protocol-alpha.opam
-
-# rename .opam files
-rename s/alpha/${version}-${short_hash}/ $(find -name \*.opam)
-
-# fix content of dune and opam files
-sed -i --follow-symlink \
- -e s/_alpha/_${version}_${short_hash}/g \
- -e s/-alpha/-${version}-${short_hash}/g \
- $(find . -name dune -or -name \*.opam)
-
-# rename genesis except if in master
-if [[ ! "$master" ]]; then
- #rename genesis
- sed -i --follow-symlink \
- -e "s/-genesis/-000-Ps9mPmXa/" \
- $(find . -name dune -or -name \*.opam)
-
- sed -i --follow-symlink \
- -e "s/_genesis/_000_Ps9mPmXa/" \
- $(find lib_delegate/test -type f)
-
-fi
diff --git a/vendors/tezos-modded/scripts/update_hashes.sh b/vendors/tezos-modded/scripts/update_hashes.sh
deleted file mode 100755
index 42f2f7da9..000000000
--- a/vendors/tezos-modded/scripts/update_hashes.sh
+++ /dev/null
@@ -1,49 +0,0 @@
-#! /bin/sh
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-cd "$script_dir"/..
-
-branch=$1
-has_git() {
- which git && [ -d .git ]
-}
-
-if has_git && ! [ -z "$(git status -s)" ] ; then
- echo "This script cannot be applied within a dirty git directory,"
- echo "you need 'stash' or 'commit' your changes before."
- exit 1
-fi
-
-set -e
-
-current_hash_genesis=`jq '.hash' < src/proto_genesis/lib_protocol/src/TEZOS_PROTOCOL | tr -d '"'`
-echo "Genesis's current hash: $current_hash_genesis"
-genesis_tmpdir=`mktemp -d`
-mkdir $genesis_tmpdir/src
-cp src/proto_genesis/lib_protocol/src/*.ml src/proto_genesis/lib_protocol/src/*.mli $genesis_tmpdir/src/
-grep -v '"hash"' < src/proto_genesis/lib_protocol/src/TEZOS_PROTOCOL > $genesis_tmpdir/src/TEZOS_PROTOCOL
-new_hash_genesis=`./tezos-protocol-compiler -hash-only $genesis_tmpdir/tmp $genesis_tmpdir/src`
-echo "Genesis's new hash: $new_hash_genesis"
-if [ "$current_hash_genesis" != "$new_hash_genesis" ]
-then
- find . -type f -exec sed "s/$current_hash_genesis/$new_hash_genesis/g" -i {} \;
- git commit -a -m "Update proto Genesis's hash"
-else
- echo "Proto Genesis's hash hasn't changed, nothing to do"
-fi
-
-current_hash_alpha=`jq '.hash' < src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL | tr -d '"'`
-echo "Alpha's current hash: $current_hash_alpha"
-alpha_tmpdir=`mktemp -d`
-mkdir $alpha_tmpdir/src
-cp src/proto_alpha/lib_protocol/src/*.ml src/proto_alpha/lib_protocol/src/*.mli $alpha_tmpdir/src/
-grep -v '"hash"' < src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL > $alpha_tmpdir/src/TEZOS_PROTOCOL
-new_hash_alpha=`./tezos-protocol-compiler -hash-only $alpha_tmpdir/tmp $alpha_tmpdir/src`
-echo "Alpha's new hash: $new_hash_alpha"
-if [ "$current_hash_alpha" != "$new_hash_alpha" ]
-then
- find src/proto_alpha src/bin_client docs -type f -exec sed "s/$current_hash_alpha/$new_hash_alpha/g" -i {} \;
- git commit -a -m "Update proto Alpha's hash"
-else
- echo "Proto Alpha's hash hasn't changed, nothing to do"
-fi
diff --git a/vendors/tezos-modded/scripts/update_opam_repo.sh b/vendors/tezos-modded/scripts/update_opam_repo.sh
deleted file mode 100755
index f5b046305..000000000
--- a/vendors/tezos-modded/scripts/update_opam_repo.sh
+++ /dev/null
@@ -1,117 +0,0 @@
-#! /bin/sh
-
-# Update the repository of opam packages used by tezos. Tezos uses a
-# private, shrunk down, opam repository to store all its
-# dependencies. This is generated by the official opam repository
-# (branch master) and then filtered using opam admin to include only
-# the cone of tezos dependencies. This repository is then used to
-# create the based opam image used by the CI to compile tezos and to
-# generate the docker images. From time to time, when it is necessary
-# to update a dependency, this repository should be manually
-# refreshed. This script takes care of generating a patch for the
-# private opam tezos repository. This patch must be applied manually
-# w.r.t. the master branch. The procedure is as follows :
-#
-# 1. Update the variable `full_opam_repository_tag` in `version.sh` to
-# a commit hash from the master branch of the official
-# opam-repository. All the required packages will be extracted from
-# this snapshot to the repo.
-#
-# 2. Run this script, it will generate a file `opam_repo.patch`
-#
-# 3. Review the patch.
-#
-# 4. In the tezos opam-repository, create a new branch from master and
-# apply this patch. Push the patch and create a merge request. A
-# new docker image with all the prebuilt dependencies will be
-# created by the CI.
-#
-# 5. Update the variable `opam_repository_tag` in files
-# `scripts/version.sh` and `.gitlab-ci.yml` with the hash of the
-# newly created commit in `tezos/opam-repository`.
-#
-# 6. Enjoy your new dependencies
-
-set -e
-
-target="$(pwd)"/opam_repo.patch tmp_dir=$(mktemp -dt tezos_deps_opam.XXXXXXXX)
-
-cleanup () {
- set +e
- echo Cleaning up...
- rm -rf "$tmp_dir"
- rm -rf Dockerfile
-}
-trap cleanup EXIT INT
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-. "$script_dir"/version.sh
-
-opams=$(find "$src_dir/vendors" "$src_dir/src" -name \*.opam -print)
-
-## Full snapshot of the opam repository
-git clone https://github.com/ocaml/opam-repository -b master "$tmp_dir"
-
-
-## Adding the various tezos packages
-packages=
-for opam in $opams; do
-
- dir=$(dirname $opam)
- file=$(basename $opam)
- package=${file%.opam}
- packages=$packages,$package
- mkdir -p "$tmp_dir"/packages/$package/$package.dev
-
- ## HACK: For some reason, `opam admin list/filter` do not follow
- ## `--with-test/doc` for 'toplevel' package, only for their
- ## 'dependencies. We want the exact opposite (like for `opam
- ## install`), so we manually remove the tag in the most
- ## ugliest-possible way...
-
- sed -e "s/{ *with-test *}//" \
- -e "s/with-test \& //" \
- -e "s/\& with-test//" \
- -e "s/{ *with-doc *}//" \
- -e "s/with-doc \& //" \
- -e "s/\& with-doc//" \
- $opam > "$tmp_dir"/packages/$package/$package.dev/opam
-
-done
-
-## Filtering unrequired packages
-cd $tmp_dir
-
-git reset --hard "$full_opam_repository_tag"
-opam admin filter --yes \
- --resolve $packages,ocaml,ocaml-base-compiler,odoc,opam-depext,js_of_ocaml-ppx
-
-## Adding useful compiler variants
-for variant in afl flambda fp fp+flambda ; do
- git checkout packages/ocaml-variants/ocaml-variants.$ocaml_version+$variant
-done
-
-## Removing the various tezos packages
-for opam in $opams; do
- file=$(basename $opam)
- package=${file%.opam}
- rm -r "$tmp_dir"/packages/$package
-done
-
-## Adding safer hashes
-opam admin add-hashes sha256 sha512
-
-## Generating the diff!
-git remote add tezos $opam_repository_url
-git fetch tezos
-git reset "$opam_repository_tag"
-git add packages
-git diff HEAD -- packages > "$target"
-
-echo
-echo "Wrote proposed update in: $target."
-echo 'Please add this patch to: `https://gitlab.com/tezos/opam-repository`'
-echo 'And update accordingly the commit hash in: `.gitlab-ci.yml` and `scripts/version.sh`'
-echo
diff --git a/vendors/tezos-modded/scripts/update_opam_test.sh b/vendors/tezos-modded/scripts/update_opam_test.sh
deleted file mode 100755
index 09499b8ae..000000000
--- a/vendors/tezos-modded/scripts/update_opam_test.sh
+++ /dev/null
@@ -1,30 +0,0 @@
-#! /bin/sh
-
-set -e
-
-script_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
-src_dir="$(dirname "$script_dir")"
-
-. "$script_dir/opam-pin.sh"
-
-tmp=$(mktemp)
-
-sed -z 's/^\(.*##BEGIN_OPAM##\n\).*\(\n##END_OPAM##.*\)$/\1/' "$src_dir/.gitlab-ci.yml" > $tmp
-
-cpt=0
-for package in $packages; do
- num=$(printf "%02d" $cpt)
- cpt=$((cpt+1))
- cat >> $tmp <> $tmp
-
-mv $tmp "$src_dir/.gitlab-ci.yml"
-
diff --git a/vendors/tezos-modded/scripts/version.sh b/vendors/tezos-modded/scripts/version.sh
deleted file mode 100644
index 03230dc7d..000000000
--- a/vendors/tezos-modded/scripts/version.sh
+++ /dev/null
@@ -1,13 +0,0 @@
-#! /bin/sh
-
-## `ocaml-version` should be in sync with `README.rst` and
-## `lib.protocol-compiler/tezos-protocol-compiler.opam`
-
-ocaml_version=4.06.1
-opam_version=2.0
-
-## Please update `.gitlab-ci.yml` accordingly
-opam_repository_tag=9f0956e21f4dcd2803d83072903872eba196bef8
-full_opam_repository_tag=3ed20d6cfd8a35fd8b459bec3a30e149b6dc03d4
-opam_repository_url=https://gitlab.com/tezos/opam-repository.git
-opam_repository=$opam_repository_url\#$opam_repository_tag
diff --git a/vendors/tezos-modded/scripts/zeronet.patch b/vendors/tezos-modded/scripts/zeronet.patch
deleted file mode 100644
index 121dc04ff..000000000
--- a/vendors/tezos-modded/scripts/zeronet.patch
+++ /dev/null
@@ -1,21 +0,0 @@
-diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml
---- a/src/bin_node/node_config_file.ml
-+++ b/src/bin_node/node_config_file.ml
-@@ -14,7 +14,7 @@ let home =
- with Not_found -> "/root"
-
- let default_data_dir = home // ".tezos-node"
--let default_p2p_port = 9732
-+let default_p2p_port = 19732
- let default_rpc_port = 8732
-
- type t = {
-@@ -85,7 +85,7 @@ let default_p2p_limits : P2p.limits = {
-
- let default_p2p = {
- expected_pow = 24. ;
-- bootstrap_peers = ["bootstrap.tezos.com"] ;
-+ bootstrap_peers = [ "52.47.156.43" ; "35.182.249.228" ; "13.231.173.142" ] ;
- listen_addr = Some ("[::]:" ^ string_of_int default_p2p_port) ;
- closed = false ;
- limits = default_p2p_limits ;
diff --git a/vendors/tezos-modded/scripts/zeronet.sh b/vendors/tezos-modded/scripts/zeronet.sh
deleted file mode 120000
index 34a626507..000000000
--- a/vendors/tezos-modded/scripts/zeronet.sh
+++ /dev/null
@@ -1 +0,0 @@
-alphanet.sh
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_attacker/attacker_main.ml b/vendors/tezos-modded/src/bin_attacker/attacker_main.ml
deleted file mode 100644
index 842e19e75..000000000
--- a/vendors/tezos-modded/src/bin_attacker/attacker_main.ml
+++ /dev/null
@@ -1,26 +0,0 @@
-(*****************************************************************************)
-(* *)
-(* Open Source License *)
-(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *)
-(* *)
-(* Permission is hereby granted, free of charge, to any person obtaining a *)
-(* copy of this software and associated documentation files (the "Software"),*)
-(* to deal in the Software without restriction, including without limitation *)
-(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
-(* and/or sell copies of the Software, and to permit persons to whom the *)
-(* Software is furnished to do so, subject to the following conditions: *)
-(* *)
-(* The above copyright notice and this permission notice shall be included *)
-(* in all copies or substantial portions of the Software. *)
-(* *)
-(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
-(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
-(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
-(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
-(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
-(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
-(* DEALINGS IN THE SOFTWARE. *)
-(* *)
-(*****************************************************************************)
-
-let () = Attacker_minimal.main ()
diff --git a/vendors/tezos-modded/src/bin_attacker/attacker_minimal.ml b/vendors/tezos-modded/src/bin_attacker/attacker_minimal.ml
deleted file mode 100644
index 4c852e41c..000000000
--- a/vendors/tezos-modded/src/bin_attacker/attacker_minimal.ml
+++ /dev/null
@@ -1,336 +0,0 @@
-(*****************************************************************************)
-(* *)
-(* Open Source License *)
-(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *)
-(* *)
-(* Permission is hereby granted, free of charge, to any person obtaining a *)
-(* copy of this software and associated documentation files (the "Software"),*)
-(* to deal in the Software without restriction, including without limitation *)
-(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
-(* and/or sell copies of the Software, and to permit persons to whom the *)
-(* Software is furnished to do so, subject to the following conditions: *)
-(* *)
-(* The above copyright notice and this permission notice shall be included *)
-(* in all copies or substantial portions of the Software. *)
-(* *)
-(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
-(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
-(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
-(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
-(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
-(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
-(* DEALINGS IN THE SOFTWARE. *)
-(* *)
-(*****************************************************************************)
-
-open Format
-include Logging.Make(struct let name = "attacker" end)
-
-module Proto = Client_embedded_proto_alpha
-
-(* the genesis block and network *)
-let genesis_block_hashed = Block_hash.of_b58check
- "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
-let network = Store.Net genesis_block_hashed
-let network = Store.Chain_id.Id genesis_block_hashed
-
-(* the bootstrap accounts and actions like signing to do with them *)
-let source_account = List.nth Proto.Bootstrap_storage.accounts 4
-let destination_account = List.nth Proto.Bootstrap_storage.accounts 0
-let wrong_account = List.nth Proto.Bootstrap_storage.accounts 1
-let another_account = List.nth Proto.Bootstrap_storage.accounts 2
-let signed = Ed25519.append_signature source_account.secret_key
-let signed_wrong = Ed25519.append_signature wrong_account.secret_key
-
-(* forge a block from a list of operations *)
-let block_forged ?prev ops =
- let from_int64 x =
- [ MBytes.of_string Proto.Constants_repr.version_number ;
- Proto.Fitness_repr.int64_to_bytes x ] in
- let pred = match prev with None -> genesis_block_hashed | Some x -> x in
- let block ops = Store.Block_header.{ chain_id = network ;
- predecessor = pred ;
- timestamp = Time.now () ;
- fitness = from_int64 1L;
- operations = ops } in
- let open Proto in
- let generate_proof_of_work_nonce () =
- Rand.generate
- Proto.Alpha_context.Constants.proof_of_work_nonce_size in
- let generate_seed_nonce () =
- match Proto.Nonce_storage.of_bytes @@
- Rand.generate
- Proto.Alpha_context.Constants.nonce_length with
- | Error _ -> assert false
- | Ok nonce -> nonce in
- Block_repr.forge_header (block ops)
- Block_repr.{
- baking_slot = {level = Raw_level_repr.of_int32_exn 1l ; priority = 0l } ;
- seed_nonce_hash = Proto.Nonce_storage.hash (generate_seed_nonce ());
- proof_of_work_nonce = generate_proof_of_work_nonce () ;
- }
-
-(* forge a transaction *)
-let tx_forged ?dest amount fee =
- let open Proto.Operation_repr in
- let open Proto.Tez_repr in
- let open Proto.Contract_repr in
- let trgt
- = match dest with
- None -> destination_account
- | Some dest -> dest in
- let src = source_account in
- let tx = Transaction
- { amount = of_cents_exn amount ;
- parameters = None ;
- destination = default_contract trgt.public_key_hash ; } in
- let op = Sourced_operations
- ( Manager_operations
- { source = default_contract src.public_key_hash ;
- public_key = Some src.public_key ;
- fee = of_cents_exn fee ;
- counter = 1l ;
- operations = [tx] ; }) in
- forge { chain_id = network } op
-
-(* forge a list of proposals, california eat your heart out *)
-let props_forged period props =
- let open Proto.Operation_repr in
- let src = source_account in
- let props = Proposals {
- period = period ;
- proposals = props } in
- let op = Sourced_operations (Delegate_operations {
- source = src.public_key ;
- operations = [props] }) in
- forge { chain_id = network } op
-
-(* "forge" a ballot *)
-let ballot_forged period prop vote =
- let open Proto.Operation_repr in
- let src = source_account in
- let ballot = Ballot {
- period = period ;
- proposal = prop ;
- ballot = vote
- } in
- let op = Sourced_operations (Delegate_operations {
- source = src.public_key ;
- operations = [ballot] }) in
- forge { chain_id = network } op
-
-let identity = P2p_identity.generate Crypto_box.default_target
-
-(* connect to the network, run an action and then disconnect *)
-let try_action addr port action =
- let socket = Lwt_unix.socket PF_INET6 SOCK_STREAM 0 in
- let uaddr = Ipaddr_unix.V6.to_inet_addr addr in
- Lwt_unix.connect socket (Lwt_unix.ADDR_INET (uaddr, port)) >>= fun () ->
- let io_sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 14) () in
- let conn = P2p_io_scheduler.register io_sched socket in
- P2p_connection.authenticate
- ~proof_of_work_target:Crypto_box.default_target
- ~incoming:false
- conn
- (addr, port)
- identity Distributed_db.Raw.supported_versions >>=? fun (_, auth_fd) ->
- P2p_connection.accept auth_fd Distributed_db.Raw.encoding >>= function
- | Error _ -> failwith "Connection rejected by peer."
- | Ok conn ->
- action conn >>=? fun () ->
- P2p_connection.close conn >>= fun () ->
- return_unit
-
-let replicate n x =
- let rec replicate_acc acc n x =
- if n <= 0 then acc else replicate_acc (x :: acc) (n-1) x in
- replicate_acc [] n x
-
-let send conn (msg : Distributed_db.Message.t) =
- P2p_connection.write conn (P2p.Raw.Message msg)
-
-let request_block_times block_hash n conn =
- let open Block_hash in
- lwt_log_notice
- "requesting %a block %d times"
- pp_short block_hash n >>= fun () ->
- let block_hashes = replicate n block_hash in
- send conn (Get_block_headers (network, block_hashes))
-
-let request_op_times op_signed n conn =
- let open Operation_hash in
- let op_hash = hash_bytes [op_signed] in
- lwt_log_notice "sending %a transaction" pp_short op_hash >>= fun () ->
- send conn (Operation op_signed) >>=? fun () ->
- lwt_log_notice
- "requesting %a transaction %d times"
- pp_short op_hash n >>= fun () ->
- let op_hashes = replicate n op_hash in
- send conn (Get_operations op_hashes)
-
-let send_block_size n conn =
- let bytes = MBytes.create n in
- let open Block_hash in
- lwt_log_notice
- "propagating fake %d byte block %a" n pp_short (hash_bytes [bytes]) >>= fun () ->
- send conn (Block bytes)
-
-let send_protocol_size n conn =
- let bytes = MBytes.create n in
- let open Protocol_hash in
- lwt_log_notice
- "propagating fake %d byte protocol %a"
- n pp_short (hash_bytes [bytes]) >>= fun () ->
- send conn (Protocol bytes)
-
-let send_operation_size n conn =
- let op_faked = MBytes.create n in
- let op_hashed = Operation_hash.hash_bytes [op_faked] in
- lwt_log_notice
- "propagating fake %d byte operation %a"
- n Operation_hash.pp_short op_hashed >>= fun () ->
- send conn (Operation op_faked) >>=? fun () ->
- let block = signed (block_forged [op_hashed]) in
- let block_hashed = Block_hash.hash_bytes [block] in
- lwt_log_notice
- "propagating block %a with operation"
- Block_hash.pp_short block_hashed >>= fun () ->
- send conn (Block block)
-
-let send_operation_bad_signature () conn =
- let open Operation_hash in
- let signed_wrong_op = signed_wrong (tx_forged 5L 1L) in
- let hashed_wrong_op = hash_bytes [signed_wrong_op] in
- lwt_log_notice
- "propagating operation %a with wrong signature"
- pp_short hashed_wrong_op >>= fun () ->
- send conn (Operation signed_wrong_op) >>=? fun () ->
- let block = signed (block_forged [hashed_wrong_op]) in
- let block_hashed = Block_hash.hash_bytes [block] in
- lwt_log_notice
- "propagating block %a with operation"
- Block_hash.pp_short block_hashed >>= fun () ->
- send conn (Block block)
-
-let send_block_bad_signature () conn =
- let open Block_hash in
- let signed_wrong_block = signed_wrong (block_forged []) in
- lwt_log_notice
- "propagating block %a with wrong signature"
- pp_short (hash_bytes [signed_wrong_block]) >>= fun () ->
- send conn (Block signed_wrong_block)
-
-let double_spend () conn =
- let spend account =
- let op_signed = signed (tx_forged ~dest:account 199999999L 1L) in
- let op_hashed = Operation_hash.hash_bytes [op_signed] in
- let block_signed = signed (block_forged [op_hashed]) in
- let block_hashed = Block_hash.hash_bytes [block_signed] in
- lwt_log_notice
- "propagating operation %a"
- Operation_hash.pp_short op_hashed >>= fun () ->
- send conn (Operation op_signed) >>=? fun () ->
- lwt_log_notice
- "propagating block %a"
- Block_hash.pp_short block_hashed >>= fun () ->
- send conn (Block block_signed) in
- spend destination_account >>=? fun () ->
- spend another_account
-
-let long_chain n conn =
- lwt_log_notice "propogating %d blocks" n >>= fun () ->
- let prev_ref = ref genesis_block_hashed in
- let rec loop k =
- if k < 1 then
- return_unit
- else
- let block = signed (block_forged ~prev:!prev_ref []) in
- prev_ref := Block_hash.hash_bytes [block] ;
- send conn (Block block) >>=? fun () ->
- loop (k-1) in
- loop n
-
-let lots_transactions amount fee n conn =
- let signed_op = signed (tx_forged amount fee) in
- let rec loop k =
- if k < 1 then
- return_unit
- else
- send conn (Operation signed_op) >>=? fun () ->
- loop (k-1) in
- let ops = replicate n (Operation_hash.hash_bytes [signed_op]) in
- let signed_block = signed (block_forged ops) in
- lwt_log_notice "propogating %d transactions" n >>= fun () ->
- loop n >>=? fun () ->
- lwt_log_notice
- "propagating block %a with wrong signature"
- Block_hash.pp_short (Block_hash.hash_bytes [signed_block]) >>= fun () ->
- send conn (Block signed_block)
-
-let main () =
- let addr = Ipaddr.V6.localhost in
- let port = 9732 in
- let run_action action = try_action addr port action in
- let run_cmd_unit lwt =
- Arg.Unit begin fun () ->
- Lwt_main.run begin
- lwt () >>= function
- | Ok () -> Lwt.return_unit
- | Error err ->
- lwt_log_error "Error: %a" pp_print_error err >>= fun () ->
- Lwt.return_unit
- end
- end in
- let run_cmd_int_suffix lwt =
- Arg.String begin fun str ->
- let last = str.[String.length str - 1] in
- let init = String.sub str 0 (String.length str - 1) in
- let n =
- if last == 'k' || last == 'K'
- then int_of_string init * 1 lsl 10
- else if last == 'm' || last == 'M'
- then int_of_string init * 1 lsl 20
- else if last == 'g' || last == 'G'
- then int_of_string init * 1 lsl 30
- else int_of_string str in
- Lwt_main.run begin
- lwt n >>= function
- | Ok () -> Lwt.return_unit
- | Error err ->
- lwt_log_error "Error: %a" pp_print_error err >>= fun () ->
- Lwt.return_unit
- end
- end in
- let cmds =
- [( "-1",
- run_cmd_int_suffix (run_action << request_block_times genesis_block_hashed),
- "[N {,K,M,G}] Attempt to request to download N {,kilo,mega,giga}blocks.")
- ;( "-2",
- run_cmd_int_suffix (run_action << request_op_times (signed (tx_forged 5L 1L))),
- "[N {,K,M,G}] Attempt to request to download N {,kilo,mega,giga}ops.")
- ;( "-3",
- run_cmd_int_suffix (run_action << send_block_size),
- "[N {,K,M,G}] Attempt to propagate an N {,kilo,mega,giga}byte fake block.")
- ;( "-4",
- run_cmd_int_suffix (run_action << send_operation_size),
- "[N {,K,M,G}] Attempt to propagate an N {,kilo,mega,giga}byte fake operation.")
- ;( "-5",
- run_cmd_int_suffix (run_action << send_protocol_size),
- "[N {,K,M,G}] Attempt to propagate an N {,kilo,mega,giga}byte fake protocol.")
- ;( "-6",
- run_cmd_unit (run_action << send_operation_bad_signature),
- "Attempt to propagate a transaction with a bad signature.")
- ;( "-7",
- run_cmd_unit (run_action << send_block_bad_signature),
- "Attempt to propagate a block with a bad signature.")
- ;( "-8",
- run_cmd_unit (run_action << double_spend),
- "Attempt to send the same transaction in two blocks")
- ; ( "-9",
- run_cmd_int_suffix (run_action << long_chain),
- "[N {,K,M,G}] Attempt to send a chain of N {,kilo,mega,giga}blocks")
- ; ( "-10",
- run_cmd_int_suffix (run_action << lots_transactions 0L 0L),
- "[N {,K,M,G}] Attempt to send N {,kilo,mega,giga}ops")
- ] in
- Arg.parse cmds print_endline "Tezos Evil Client"
diff --git a/vendors/tezos-modded/src/bin_attacker/attacker_minimal.mli b/vendors/tezos-modded/src/bin_attacker/attacker_minimal.mli
deleted file mode 100644
index 69783195e..000000000
--- a/vendors/tezos-modded/src/bin_attacker/attacker_minimal.mli
+++ /dev/null
@@ -1,26 +0,0 @@
-(*****************************************************************************)
-(* *)
-(* Open Source License *)
-(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *)
-(* *)
-(* Permission is hereby granted, free of charge, to any person obtaining a *)
-(* copy of this software and associated documentation files (the "Software"),*)
-(* to deal in the Software without restriction, including without limitation *)
-(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
-(* and/or sell copies of the Software, and to permit persons to whom the *)
-(* Software is furnished to do so, subject to the following conditions: *)
-(* *)
-(* The above copyright notice and this permission notice shall be included *)
-(* in all copies or substantial portions of the Software. *)
-(* *)
-(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
-(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
-(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
-(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
-(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
-(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
-(* DEALINGS IN THE SOFTWARE. *)
-(* *)
-(*****************************************************************************)
-
-val main: unit -> unit
diff --git a/vendors/tezos-modded/src/bin_client/bash-completion.sh b/vendors/tezos-modded/src/bin_client/bash-completion.sh
deleted file mode 100755
index 6546573a3..000000000
--- a/vendors/tezos-modded/src/bin_client/bash-completion.sh
+++ /dev/null
@@ -1,54 +0,0 @@
-_tezos-client_complete()
-{
- local cur_word prev_word type_list
-
- cur_word="${COMP_WORDS[COMP_CWORD]}"
- prev_word="${COMP_WORDS[COMP_CWORD-1]}"
-
- # Tezos script
- script=${COMP_WORDS[0]}
-
- reply=$($script bash_autocomplete "$prev_word" "$cur_word" ${COMP_WORDS[@]} 2>/dev/null)
-
- COMPREPLY=($(compgen -W "$reply" -- $cur_word))
-
- return 0
-}
-
-_tezos-alphanet_complete()
-{
- script="${COMP_WORDS[0]}"
- second="${COMP_WORDS[1]}"
- cur_word="${COMP_WORDS[COMP_CWORD]}"
- case "$second" in
- container)
- COMPREPLY=($(compgen -W "start stop status" -- $cur_word));;
- node)
- COMPREPLY=($(compgen -W "start stop status log" -- $cur_word));;
- baker)
- COMPREPLY=($(compgen -W "start stop status log" -- $cur_word));;
- endorser)
- COMPREPLY=($(compgen -W "start stop status log" -- $cur_word));;
- client)
- ;;
- # prev_word="${COMP_WORDS[COMP_CWORD-1]}"
- # unset COMP_WORDS[0]
- # echo $script client bash_autocomplete "$prev_word" "$cur_word" ${COMP_WORDS[@]:1} > /tmp/completions
- # reply=$($script client bash_autocomplete "$prev_word" "$cur_word" ${COMP_WORDS[@]:1})
- # COMPREPLY=$($(compgen -W "$reply" -- $cur_word));;
- *)
- COMPREPLY=($(compgen -W "start restart \
- clear status stop kill head \
- go_alpha_go shell client check_script update_script \
- container node baker endorser" -- $cur_word));;
- esac
- return 0
-}
-
-# Register _pss_complete to provide completion for the following commands
-complete -F _tezos-client_complete tezos-client
-complete -F _tezos-client_complete tezos-admin-client
-complete -F _tezos-client_complete tezos-baker-alpha
-complete -F _tezos-client_complete tezos-endorser-alpha
-complete -F _tezos-client_complete tezos-accuser-alpha
-complete -F _tezos-alphanet_complete alphanet.sh
diff --git a/vendors/tezos-modded/src/bin_client/client_protocols_commands.ml b/vendors/tezos-modded/src/bin_client/client_protocols_commands.ml
deleted file mode 100644
index 8d5f8f036..000000000
--- a/vendors/tezos-modded/src/bin_client/client_protocols_commands.ml
+++ /dev/null
@@ -1,83 +0,0 @@
-(*****************************************************************************)
-(* *)
-(* Open Source License *)
-(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *)
-(* *)
-(* Permission is hereby granted, free of charge, to any person obtaining a *)
-(* copy of this software and associated documentation files (the "Software"),*)
-(* to deal in the Software without restriction, including without limitation *)
-(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
-(* and/or sell copies of the Software, and to permit persons to whom the *)
-(* Software is furnished to do so, subject to the following conditions: *)
-(* *)
-(* The above copyright notice and this permission notice shall be included *)
-(* in all copies or substantial portions of the Software. *)
-(* *)
-(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
-(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
-(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
-(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
-(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
-(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
-(* DEALINGS IN THE SOFTWARE. *)
-(* *)
-(*****************************************************************************)
-
-let group =
- { Clic.name = "protocols" ;
- title = "Commands for managing protocols" }
-
-let commands () =
- let open Clic in
- let check_dir _ dn =
- if Sys.is_directory dn then
- return dn
- else
- failwith "%s is not a directory" dn in
- let check_dir_parameter = parameter check_dir in
- [
-
- command ~group ~desc: "List protocols known by the node."
- no_options
- (prefixes [ "list" ; "protocols" ] stop)
- (fun () (cctxt : #Client_context.full) ->
- Shell_services.Protocol.list cctxt >>=? fun protos ->
- Lwt_list.iter_s (fun ph -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () ->
- return_unit
- );
-
- command ~group ~desc: "Inject a new protocol into the node."
- no_options
- (prefixes [ "inject" ; "protocol" ]
- @@ param ~name:"dir" ~desc:"directory containing the sources of a protocol" check_dir_parameter
- @@ stop)
- (fun () dirname (cctxt : #Client_context.full) ->
- Lwt.catch
- (fun () ->
- Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) ->
- Shell_services.Injection.protocol cctxt proto >>= function
- | Ok hash ->
- cctxt#message "Injected protocol %a successfully" Protocol_hash.pp hash >>= fun () ->
- return_unit
- | Error err ->
- cctxt#error "Error while injecting protocol from %s: %a"
- dirname Error_monad.pp_print_error err >>= fun () ->
- return_unit)
- (fun exn ->
- cctxt#error "Error while injecting protocol from %s: %a"
- dirname Error_monad.pp_print_error [Error_monad.Exn exn] >>= fun () ->
- return_unit)
- );
-
- command ~group ~desc: "Dump a protocol from the node's record of protocol."
- no_options
- (prefixes [ "dump" ; "protocol" ]
- @@ Protocol_hash.param ~name:"protocol hash" ~desc:""
- @@ stop)
- (fun () ph (cctxt : #Client_context.full) ->
- Shell_services.Protocol.contents cctxt ph >>=? fun proto ->
- Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () ->
- cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->
- return_unit
- ) ;
- ]
diff --git a/vendors/tezos-modded/src/bin_client/client_protocols_commands.mli b/vendors/tezos-modded/src/bin_client/client_protocols_commands.mli
deleted file mode 100644
index d50cc7538..000000000
--- a/vendors/tezos-modded/src/bin_client/client_protocols_commands.mli
+++ /dev/null
@@ -1,26 +0,0 @@
-(*****************************************************************************)
-(* *)
-(* Open Source License *)
-(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc.